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
autodoc.pl: varargs fcns require full 'Perl_foo'
[perl5.git] / pp_pack.c
diff --git a/pp_pack.c b/pp_pack.c
index 6c9b92a..8ac5316 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1,7 +1,7 @@
 /*    pp_pack.c
  *
 /*    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
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -14,6 +14,8 @@
  * wooden spoon, a short two-pronged fork and some skewers were stowed; and
  * hidden at the bottom of the pack in a flat wooden box a dwindling treasure,
  * some salt.
  * wooden spoon, a short two-pronged fork and some skewers were stowed; and
  * hidden at the bottom of the pack in a flat wooden box a dwindling treasure,
  * some salt.
+ *
+ *     [p.653 of _The Lord of the Rings_, IV/iv: "Of Herbs and Stewed Rabbit"]
  */
 
 /* This file contains pp ("push/pop") functions that
  */
 
 /* This file contains pp ("push/pop") functions that
@@ -26,19 +28,65 @@
  * other pp*.c files for the rest of the pp_ functions.
  */
 
  * other pp*.c files for the rest of the pp_ functions.
  */
 
-
 #include "EXTERN.h"
 #define PERL_IN_PP_PACK_C
 #include "perl.h"
 
 #include "EXTERN.h"
 #define PERL_IN_PP_PACK_C
 #include "perl.h"
 
-#if PERL_VERSION >= 9
-# define PERL_PACK_CAN_BYTEORDER
-# define PERL_PACK_CAN_SHRIEKSIGN
+/* Types used by pack/unpack */ 
+typedef enum {
+  e_no_len,     /* no length  */
+  e_number,     /* number, [] */
+  e_star        /* asterisk   */
+} howlen_t;
+
+typedef struct tempsym {
+  const char*    patptr;   /* current template char */
+  const char*    patend;   /* one after last char   */
+  const char*    grpbeg;   /* 1st char of ()-group  */
+  const char*    grpend;   /* end of ()-group       */
+  I32      code;     /* template code (!<>)   */
+  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;
+
+#define TEMPSYM_INIT(symptr, p, e, f) \
+    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   = e_no_len;  \
+       (symptr)->level    = 0;         \
+       (symptr)->flags    = (f);       \
+       (symptr)->strbeg   = 0;         \
+       (symptr)->previous = NULL;      \
+   } STMT_END
+
+typedef union {
+    NV nv;
+    U8 bytes[sizeof(NV)];
+} NV_bytes;
+
+#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+typedef union {
+    long double ld;
+    U8 bytes[sizeof(long double)];
+} ld_bytes;
 #endif
 
 #ifndef CHAR_BIT
 # define CHAR_BIT      8
 #endif
 #endif
 
 #ifndef CHAR_BIT
 # define CHAR_BIT      8
 #endif
+/* Maximum number of bytes to which a byte can grow due to upgrade */
+#define UTF8_EXPAND    2
 
 /*
  * Offset for integer pack/unpack.
 
 /*
  * Offset for integer pack/unpack.
@@ -64,60 +112,63 @@
 /* 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
 
 #endif
 
-/* Only to be used inside a loop (see the break) */
-#define SHIFT16(utf8, s, strend, p, datumtype) STMT_START {            \
-    if (utf8) {                                                                \
-       if (!uni_to_bytes(aTHX_ &(s), strend, OFF16(p), SIZE16, datumtype)) break;      \
-    } else {                                                           \
-       Copy(s, OFF16(p), SIZE16, char);                                \
-       (s) += SIZE16;                                                  \
-    }                                                                  \
-} STMT_END
+#define PUSH16(utf8, cur, p, needs_swap)                        \
+       PUSH_BYTES(utf8, cur, OFF16(p), SIZE16, needs_swap)
+#define PUSH32(utf8, cur, p, needs_swap)                        \
+       PUSH_BYTES(utf8, cur, OFF32(p), SIZE32, needs_swap)
 
 
-/* Only to be used inside a loop (see the break) */
-#define SHIFT32(utf8, s, strend, p, datumtype) STMT_START {            \
-    if (utf8) {                                                                \
-       if (!uni_to_bytes(aTHX_ &(s), strend, OFF32(p), SIZE32, datumtype)) break;      \
-    } else {                                                           \
-       Copy(s, OFF32(p), SIZE32, char);                                \
-       (s) += SIZE32;                                                  \
-    }                                                                  \
-} STMT_END
-
-#define PUSH16(utf8, cur, p) PUSH_BYTES(utf8, cur, OFF16(p), SIZE16)
-#define PUSH32(utf8, cur, p) PUSH_BYTES(utf8, cur, OFF32(p), SIZE32)
+#if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /* big-endian */
+#  define NEEDS_SWAP(d)     (TYPE_ENDIANNESS(d) == TYPE_IS_LITTLE_ENDIAN)
+#elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678  /* little-endian */
+#  define NEEDS_SWAP(d)     (TYPE_ENDIANNESS(d) == TYPE_IS_BIG_ENDIAN)
+#else
+#  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 S_utf8_to_bytes would need
+           logic adding to deal with any mixed-endian transformations needed.
+        */
+#endif
 
 /* Only to be used inside a loop (see the break) */
 
 /* Only to be used inside a loop (see the break) */
-#define SHIFT_VAR(utf8, s, strend, var, datumtype)     \
+#define SHIFT_BYTES(utf8, s, strend, buf, len, datumtype, needs_swap)  \
 STMT_START {                                           \
 STMT_START {                                           \
-    if (utf8) {                                                \
-        if (!uni_to_bytes(aTHX_ &s, strend,            \
-            (char *) &var, sizeof(var), datumtype)) break;\
+    if (UNLIKELY(utf8)) {                               \
+        if (!S_utf8_to_bytes(aTHX_ &s, strend,         \
+         (char *) (buf), len, datumtype)) break;       \
     } else {                                           \
     } else {                                           \
-        Copy(s, (char *) &var, sizeof(var), char);     \
-        s += sizeof(var);                              \
+        if (UNLIKELY(needs_swap))                       \
+            S_reverse_copy(s, (char *) (buf), len);     \
+        else                                            \
+            Copy(s, (char *) (buf), len, char);                \
+        s += len;                                      \
     }                                                  \
 } STMT_END
 
     }                                                  \
 } STMT_END
 
-#define PUSH_VAR(utf8, aptr, var)      \
-       PUSH_BYTES(utf8, aptr, (char *) &(var), sizeof(var))
+#define SHIFT16(utf8, s, strend, p, datumtype, needs_swap)              \
+       SHIFT_BYTES(utf8, s, strend, OFF16(p), SIZE16, datumtype, needs_swap)
+
+#define SHIFT32(utf8, s, strend, p, datumtype, needs_swap)              \
+       SHIFT_BYTES(utf8, s, strend, OFF32(p), SIZE32, datumtype, needs_swap)
+
+#define SHIFT_VAR(utf8, s, strend, var, datumtype, needs_swap)          \
+       SHIFT_BYTES(utf8, s, strend, &(var), sizeof(var), datumtype, needs_swap)
+
+#define PUSH_VAR(utf8, aptr, var, needs_swap)           \
+       PUSH_BYTES(utf8, aptr, &(var), sizeof(var), needs_swap)
 
 /* Avoid stack overflow due to pathological templates. 100 should be plenty. */
 #define MAX_SUB_TEMPLATE_LEVEL 100
 
 /* Avoid stack overflow due to pathological templates. 100 should be plenty. */
 #define MAX_SUB_TEMPLATE_LEVEL 100
@@ -137,10 +188,11 @@ S_mul128(pTHX_ SV *sv, U8 m)
   STRLEN          len;
   char           *s = SvPV(sv, len);
   char           *t;
   STRLEN          len;
   char           *s = SvPV(sv, len);
   char           *t;
-  U32             i = 0;
 
 
-  if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
-    SV             *tmpNew = newSVpvn("0000000000", 10);
+  PERL_ARGS_ASSERT_MUL128;
+
+  if (! memBEGINs(s, len, "0000")) {  /* need to grow sv */
+    SV * const tmpNew = newSVpvs("0000000000");
 
     sv_catsv(tmpNew, sv);
     SvREFCNT_dec(sv);          /* free old sv */
 
     sv_catsv(tmpNew, sv);
     SvREFCNT_dec(sv);          /* free old sv */
@@ -151,7 +203,7 @@ S_mul128(pTHX_ SV *sv, U8 m)
   while (!*t)                   /* trailing '\0'? */
     t--;
   while (t > s) {
   while (!*t)                   /* trailing '\0'? */
     t--;
   while (t > s) {
-    i = ((*t - '0') << 7) + m;
+    const U32 i = ((*t - '0') << 7) + m;
     *(t--) = '0' + (char)(i % 10);
     m = (char)(i / 10);
   }
     *(t--) = '0' + (char)(i % 10);
     m = (char)(i / 10);
   }
@@ -160,16 +212,9 @@ 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)    inRANGE(NATIVE_TO_LATIN1(ch),               \
+                                NATIVE_TO_LATIN1(' '),              \
+                                NATIVE_TO_LATIN1('a') - 1)
 
 /* type modifiers */
 #define TYPE_IS_SHRIEKING      0x100
 
 /* type modifiers */
 #define TYPE_IS_SHRIEKING      0x100
@@ -180,500 +225,185 @@ S_mul128(pTHX_ SV *sv, U8 m)
 #define TYPE_MODIFIERS(t)      ((t) & ~0xFF)
 #define TYPE_NO_MODIFIERS(t)   ((t) & 0xFF)
 
 #define TYPE_MODIFIERS(t)      ((t) & ~0xFF)
 #define TYPE_NO_MODIFIERS(t)   ((t) & 0xFF)
 
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
-#define SHRIEKING_ALLOWED_TYPES "sSiIlLxXnNvV"
-#else
-#define SHRIEKING_ALLOWED_TYPES "sSiIlLxX"
-#endif
-
-#ifndef PERL_PACK_CAN_BYTEORDER
-/* Put "can't" first because it is shorter  */
-# define TYPE_ENDIANNESS(t)    0
-# define TYPE_NO_ENDIANNESS(t) (t)
-
-# define ENDIANNESS_ALLOWED_TYPES   ""
-
-# 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_N(var, type)
-# define DO_BO_PACK_N(var, type)
-# define DO_BO_UNPACK_P(var)
-# define DO_BO_PACK_P(var)
-
-#else /* PERL_PACK_CAN_BYTEORDER */
-
 # define TYPE_ENDIANNESS(t)    ((t) & TYPE_ENDIANNESS_MASK)
 # define TYPE_NO_ENDIANNESS(t) ((t) & ~TYPE_ENDIANNESS_MASK)
 
 # define ENDIANNESS_ALLOWED_TYPES   "sSiIlLqQjJfFdDpP("
 
 # define TYPE_ENDIANNESS(t)    ((t) & TYPE_ENDIANNESS_MASK)
 # define TYPE_NO_ENDIANNESS(t) ((t) & ~TYPE_ENDIANNESS_MASK)
 
 # define ENDIANNESS_ALLOWED_TYPES   "sSiIlLqQjJfFdDpP("
 
-# define DO_BO_UNPACK(var, type)                                              \
-        STMT_START {                                                          \
-          switch (TYPE_ENDIANNESS(datumtype)) {                               \
-            case TYPE_IS_BIG_ENDIAN:    var = my_betoh ## type (var); break;  \
-            case TYPE_IS_LITTLE_ENDIAN: var = my_letoh ## type (var); break;  \
-            default: break;                                                   \
-          }                                                                   \
-        } STMT_END
-
-# define DO_BO_PACK(var, type)                                                \
-        STMT_START {                                                          \
-          switch (TYPE_ENDIANNESS(datumtype)) {                               \
-            case TYPE_IS_BIG_ENDIAN:    var = my_htobe ## type (var); break;  \
-            case TYPE_IS_LITTLE_ENDIAN: var = my_htole ## type (var); break;  \
-            default: break;                                                   \
-          }                                                                   \
-        } STMT_END
-
-# define DO_BO_UNPACK_PTR(var, type, pre_cast)                                \
-        STMT_START {                                                          \
-          switch (TYPE_ENDIANNESS(datumtype)) {                               \
-            case TYPE_IS_BIG_ENDIAN:                                          \
-              var = (void *) my_betoh ## type ((pre_cast) var);               \
-              break;                                                          \
-            case TYPE_IS_LITTLE_ENDIAN:                                       \
-              var = (void *) my_letoh ## type ((pre_cast) var);               \
-              break;                                                          \
-            default:                                                          \
-              break;                                                          \
-          }                                                                   \
-        } STMT_END
-
-# define DO_BO_PACK_PTR(var, type, pre_cast)                                  \
-        STMT_START {                                                          \
-          switch (TYPE_ENDIANNESS(datumtype)) {                               \
-            case TYPE_IS_BIG_ENDIAN:                                          \
-              var = (void *) my_htobe ## type ((pre_cast) var);               \
-              break;                                                          \
-            case TYPE_IS_LITTLE_ENDIAN:                                       \
-              var = (void *) my_htole ## type ((pre_cast) var);               \
-              break;                                                          \
-            default:                                                          \
-              break;                                                          \
-          }                                                                   \
-        } STMT_END
-
-# define BO_CANT_DOIT(action, type)                                           \
-        STMT_START {                                                          \
-          switch (TYPE_ENDIANNESS(datumtype)) {                               \
-             case TYPE_IS_BIG_ENDIAN:                                         \
-               Perl_croak(aTHX_ "Can't %s big-endian %ss on this "            \
-                                "platform", #action, #type);                  \
-               break;                                                         \
-             case TYPE_IS_LITTLE_ENDIAN:                                      \
-               Perl_croak(aTHX_ "Can't %s little-endian %ss on this "         \
-                                "platform", #action, #type);                  \
-               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)
-# 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)
-# else
-#  define DO_BO_UNPACK_P(var)  BO_CANT_DOIT(unpack, pointer)
-#  define DO_BO_PACK_P(var)    BO_CANT_DOIT(pack, pointer)
-# endif
-
-# if defined(my_htolen) && defined(my_letohn) && \
-    defined(my_htoben) && defined(my_betohn)
-#  define DO_BO_UNPACK_N(var, type)                                           \
-         STMT_START {                                                         \
-           switch (TYPE_ENDIANNESS(datumtype)) {                              \
-             case TYPE_IS_BIG_ENDIAN:    my_betohn(&var, sizeof(type)); break;\
-             case TYPE_IS_LITTLE_ENDIAN: my_letohn(&var, sizeof(type)); break;\
-             default: break;                                                  \
-           }                                                                  \
-         } STMT_END
-
-#  define DO_BO_PACK_N(var, type)                                             \
-         STMT_START {                                                         \
-           switch (TYPE_ENDIANNESS(datumtype)) {                              \
-             case TYPE_IS_BIG_ENDIAN:    my_htoben(&var, sizeof(type)); break;\
-             case TYPE_IS_LITTLE_ENDIAN: my_htolen(&var, sizeof(type)); break;\
-             default: break;                                                  \
-           }                                                                  \
-         } STMT_END
-# else
-#  define DO_BO_UNPACK_N(var, type)    BO_CANT_DOIT(unpack, type)
-#  define DO_BO_PACK_N(var, type)      BO_CANT_DOIT(pack, type)
-# endif
-
-#endif /* PERL_PACK_CAN_BYTEORDER */
-
 #define PACK_SIZE_CANNOT_CSUM          0x80
 #define PACK_SIZE_UNPREDICTABLE                0x40    /* Not a fixed size element */
 #define PACK_SIZE_MASK                 0x3F
 
 #define PACK_SIZE_CANNOT_CSUM          0x80
 #define PACK_SIZE_UNPREDICTABLE                0x40    /* Not a fixed size element */
 #define PACK_SIZE_MASK                 0x3F
 
+#include "packsizetables.inc"
 
 
-struct packsize_t {
-    const unsigned char *array;
-    int first;
-    int size;
-};
-
-#define PACK_SIZE_NORMAL 0
-#define PACK_SIZE_SHRIEKING 1
-
-/* These tables are regenerated by genpacksizetables.pl (and then hand pasted
-   in).  You're unlikely ever to need to regenerate them.  */
-#if 'J'-'I' == 1
-/* ASCII */
-unsigned char size_normal[53] = {
-  /* C */ sizeof(unsigned char),
-#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
-  /* D */ LONG_DOUBLESIZE,
-#else
-  0,
-#endif
-  0,
-  /* F */ NVSIZE,
-  0, 0,
-  /* I */ sizeof(unsigned int),
-  /* J */ UVSIZE,
-  0,
-  /* L */ SIZE32,
-  0,
-  /* N */ SIZE32,
-  0, 0,
-#if defined(HAS_QUAD)
-  /* Q */ sizeof(Uquad_t),
-#else
-  0,
-#endif
-  0,
-  /* S */ SIZE16,
-  0,
-  /* U */ sizeof(char) | PACK_SIZE_UNPREDICTABLE,
-  /* V */ SIZE32,
-  /* W */ sizeof(unsigned char) | PACK_SIZE_UNPREDICTABLE,
-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* c */ sizeof(char),
-  /* d */ sizeof(double),
-  0,
-  /* f */ sizeof(float),
-  0, 0,
-  /* i */ sizeof(int),
-  /* j */ IVSIZE,
-  0,
-  /* l */ SIZE32,
-  0,
-  /* n */ SIZE16,
-  0,
-  /* p */ sizeof(char *) | PACK_SIZE_CANNOT_CSUM,
-#if defined(HAS_QUAD)
-  /* q */ sizeof(Quad_t),
-#else
-  0,
-#endif
-  0,
-  /* s */ SIZE16,
-  0, 0,
-  /* v */ SIZE16,
-  /* w */ sizeof(char) | PACK_SIZE_UNPREDICTABLE | PACK_SIZE_CANNOT_CSUM,
-};
-unsigned char size_shrieking[46] = {
-  /* I */ sizeof(unsigned int),
-  0, 0,
-  /* L */ sizeof(unsigned long),
-  0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* N */ SIZE32,
-#else
-  0,
-#endif
-  0, 0, 0, 0,
-  /* S */ sizeof(unsigned short),
-  0, 0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* V */ SIZE32,
-#else
-  0,
-#endif
-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* i */ sizeof(int),
-  0, 0,
-  /* l */ sizeof(long),
-  0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* n */ SIZE16,
-#else
-  0,
-#endif
-  0, 0, 0, 0,
-  /* s */ sizeof(short),
-  0, 0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* v */ SIZE16
-#else
-  0
-#endif
-};
-struct packsize_t packsize[2] = {
-  {size_normal, 67, 53},
-  {size_shrieking, 73, 46}
-};
-#else
-/* EBCDIC (or bust) */
-unsigned char size_normal[100] = {
-  /* c */ sizeof(char),
-  /* d */ sizeof(double),
-  0,
-  /* f */ sizeof(float),
-  0, 0,
-  /* i */ sizeof(int),
-  0, 0, 0, 0, 0, 0, 0,
-  /* j */ IVSIZE,
-  0,
-  /* l */ SIZE32,
-  0,
-  /* n */ SIZE16,
-  0,
-  /* p */ sizeof(char *) | PACK_SIZE_CANNOT_CSUM,
-#if defined(HAS_QUAD)
-  /* q */ sizeof(Quad_t),
-#else
-  0,
-#endif
-  0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* s */ SIZE16,
-  0, 0,
-  /* v */ SIZE16,
-  /* w */ sizeof(char) | PACK_SIZE_UNPREDICTABLE | PACK_SIZE_CANNOT_CSUM,
-  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,
-  /* C */ sizeof(unsigned char),
-#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
-  /* D */ LONG_DOUBLESIZE,
-#else
-  0,
-#endif
-  0,
-  /* F */ NVSIZE,
-  0, 0,
-  /* I */ sizeof(unsigned int),
-  0, 0, 0, 0, 0, 0, 0,
-  /* J */ UVSIZE,
-  0,
-  /* L */ SIZE32,
-  0,
-  /* N */ SIZE32,
-  0, 0,
-#if defined(HAS_QUAD)
-  /* Q */ sizeof(Uquad_t),
-#else
-  0,
-#endif
-  0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* S */ SIZE16,
-  0,
-  /* U */ sizeof(char) | PACK_SIZE_UNPREDICTABLE,
-  /* V */ SIZE32,
-  /* W */ sizeof(unsigned char) | PACK_SIZE_UNPREDICTABLE,
-};
-unsigned char size_shrieking[93] = {
-  /* i */ sizeof(int),
-  0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* l */ sizeof(long),
-  0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* n */ SIZE16,
-#else
-  0,
-#endif
-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* s */ sizeof(short),
-  0, 0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* v */ SIZE16,
-#else
-  0,
-#endif
-  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, 0, 0, 0,
-  /* I */ sizeof(unsigned int),
-  0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* L */ sizeof(unsigned long),
-  0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* N */ SIZE32,
-#else
-  0,
-#endif
-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-  /* S */ sizeof(unsigned short),
-  0, 0,
-#if defined(PERL_PACK_CAN_SHRIEKSIGN)
-  /* V */ SIZE32
-#else
-  0
-#endif
-};
-struct packsize_t packsize[2] = {
-  {size_normal, 131, 100},
-  {size_shrieking, 137, 93}
-};
-#endif
+static void
+S_reverse_copy(const char *src, char *dest, STRLEN len)
+{
+    dest += len;
+    while (len--)
+        *--dest = *src++;
+}
 
 STATIC U8
 
 STATIC U8
-uni_to_byte(pTHX_ char **s, const char *end, I32 datumtype)
+utf8_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
 {
 {
-    UV val;
     STRLEN retlen;
     STRLEN retlen;
+    UV val;
+
+    if (*s >= end) {
+       goto croak;
+    }
     val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
     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
-       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) {
-       if (ckWARN(WARN_UNPACK))
-       Perl_warner(aTHX_ packWARN(WARN_UNPACK),
-                   "Character in '%c' format wrapped in unpack",
-                   (int) TYPE_NO_MODIFIERS(datumtype));
+       Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK),
+                      "Character in '%c' format wrapped in unpack",
+                      (int) TYPE_NO_MODIFIERS(datumtype));
        val &= 0xff;
     }
     *s += retlen;
        val &= 0xff;
     }
     *s += retlen;
-    return val;
+    return (U8)val;
 }
 
 #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_ char **s, char *end, 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;
-    char *from = *s;
+    const char *from = *s;
     int bad = 0;
     int bad = 0;
-    U32 flags = ckWARN(WARN_UTF8) ?
+    const U32 flags = ckWARN(WARN_UTF8) ?
        UTF8_CHECK_ONLY : (UTF8_CHECK_ONLY | UTF8_ALLOW_ANY);
        UTF8_CHECK_ONLY : (UTF8_CHECK_ONLY | UTF8_ALLOW_ANY);
+    const bool needs_swap = NEEDS_SWAP(datumtype);
+
+    if (UNLIKELY(needs_swap))
+        buf += 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 |= 2;
            val &= 0xff;
        }
            bad |= 1;
        } else from += retlen;
        if (val >= 0x100) {
            bad |= 2;
            val &= 0xff;
        }
-       *(U8 *)buf++ = val;
+        if (UNLIKELY(needs_swap))
+            *(U8 *)--buf = (U8)val;
+        else
+            *(U8 *)buf++ = (U8)val;
     }
     /* We have enough characters for the buffer. Did we have problems ? */
     if (bad) {
        if (bad & 1) {
            /* Rewalk the string fragment while warning */
     }
     /* We have enough characters for the buffer. Did we have problems ? */
     if (bad) {
        if (bad & 1) {
            /* Rewalk the string fragment while warning */
-           char *ptr;
-           flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+           const char *ptr;
+           const U32 flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
            for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) {
                if (ptr >= end) break;
            for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) {
                if (ptr >= end) break;
-               utf8n_to_uvuni((U8 *) ptr, end-ptr, &retlen, flags);
+               utf8n_to_uvchr((U8 *) ptr, end-ptr, &retlen, flags);
            }
            if (from > end) from = end;
        }
            }
            if (from > end) from = end;
        }
-       if ((bad & 2) && ckWARN(WARN_UNPACK))
-           Perl_warner(aTHX_ packWARN(datumtype & TYPE_IS_PACK ? 
+       if ((bad & 2))
+           Perl_ck_warner(aTHX_ packWARN(datumtype & TYPE_IS_PACK ?
                                       WARN_PACK : WARN_UNPACK),
                                       WARN_PACK : WARN_UNPACK),
-                       "Character(s) in '%c' format wrapped in %s",
-                       (int) TYPE_NO_MODIFIERS(datumtype), 
-                       datumtype & TYPE_IS_PACK ? "pack" : "unpack");
+                          "Character(s) in '%c' format wrapped in %s",
+                          (int) TYPE_NO_MODIFIERS(datumtype),
+                          datumtype & TYPE_IS_PACK ? "pack" : "unpack");
     }
     *s = from;
     return TRUE;
 }
 
     }
     *s = from;
     return TRUE;
 }
 
-STATIC bool
-next_uni_uu(pTHX_ char **s, const char *end, I32 *out)
-{
-    UV val;
-    STRLEN retlen;
-    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 *
+S_my_bytes_to_utf8(const U8 *start, STRLEN len, char *dest, const bool needs_swap) {
+    PERL_ARGS_ASSERT_MY_BYTES_TO_UTF8;
 
 
-STATIC void
-bytes_to_uni(pTHX_ U8 *start, STRLEN len, char **dest) {
-    U8 buffer[UTF8_MAXLEN];
-    U8 *end = start + len;
-    char *d = *dest;
-    while (start < end) {
-       int length =
-           uvuni_to_utf8_flags(buffer, NATIVE_TO_UNI(*start), 0) - buffer;
-       switch(length) {
-         case 1:
-           *d++ = buffer[0];
-           break;
-         case 2:
-           *d++ = buffer[0];
-           *d++ = buffer[1];
-           break;
-         default:
-           Perl_croak(aTHX_ "Perl bug: value %d UTF-8 expands to %d bytes",
-                      *start, length);
-       }
-       start++;
+    if (UNLIKELY(needs_swap)) {
+        const U8 *p = start + len;
+        while (p-- > start) {
+            append_utf8_from_native_byte(*p, (U8 **) & dest);
+        }
+    } else {
+        const U8 * const end = start + len;
+        while (start < end) {
+            append_utf8_from_native_byte(*start, (U8 **) & dest);
+            start++;
+        }
     }
     }
-    *dest = d;
+    return dest;
 }
 
 }
 
-#define PUSH_BYTES(utf8, cur, buf, len)                        \
-STMT_START {                                           \
-    if (utf8) bytes_to_uni(aTHX_ buf, len, &(cur));    \
-    else {                                             \
-       Copy(buf, cur, len, char);                      \
-       (cur) += (len);                                 \
-    }                                                  \
+#define PUSH_BYTES(utf8, cur, buf, len, needs_swap)             \
+STMT_START {                                                   \
+    if (UNLIKELY(utf8))                                                \
+       (cur) = my_bytes_to_utf8((U8 *) buf, len, (cur), needs_swap);       \
+    else {                                                     \
+        if (UNLIKELY(needs_swap))                               \
+            S_reverse_copy((char *)(buf), cur, len);            \
+        else                                                    \
+            Copy(buf, cur, len, char);                         \
+       (cur) += (len);                                         \
+    }                                                          \
+} 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);                    \
 } STMT_END
 
 #define GROWING(utf8, cat, start, cur, in_len) \
 STMT_START {                                   \
     STRLEN glen = (in_len);                    \
-    if (utf8) glen *= 2;                       \
-    if ((cur) + glen >= (start) + SvLEN(cat)) {        \
-       (start) = sv_exp_grow(aTHX_ cat, glen); \
+    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);           \
     }                                          \
 } STMT_END
 
 #define PUSH_GROWING_BYTES(utf8, cat, start, cur, buf, in_len) \
 STMT_START {                                   \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
 } STMT_END
 
 #define PUSH_GROWING_BYTES(utf8, cat, start, cur, buf, in_len) \
 STMT_START {                                   \
-    STRLEN glen = (in_len);                    \
+    const STRLEN glen = (in_len);              \
     STRLEN gl = glen;                          \
     STRLEN gl = glen;                          \
-    if (utf8) gl *= 2;                         \
+    if (utf8) SAFE_UTF8_EXPAND(gl);            \
     if ((cur) + gl >= (start) + SvLEN(cat)) {  \
         *cur = '\0';                           \
     if ((cur) + gl >= (start) + SvLEN(cat)) {  \
         *cur = '\0';                           \
-        SvCUR(cat) = (cur) - (start);          \
-       (start) = sv_exp_grow(aTHX_ cat, gl);   \
+        SvCUR_set((cat), (cur) - (start));     \
+       (start) = sv_exp_grow(cat, gl);         \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
-    PUSH_BYTES(utf8, cur, buf, glen);          \
+    PUSH_BYTES(utf8, cur, buf, glen, 0);        \
 } STMT_END
 
 #define PUSH_BYTE(utf8, s, byte)               \
 STMT_START {                                   \
     if (utf8) {                                        \
 } STMT_END
 
 #define PUSH_BYTE(utf8, s, byte)               \
 STMT_START {                                   \
     if (utf8) {                                        \
-       U8 au8 = (byte);                        \
-       bytes_to_uni(aTHX_ &au8, 1, &(s));      \
+       const U8 au8 = (byte);                  \
+       (s) = my_bytes_to_utf8(&au8, 1, (s), 0);\
     } else *(U8 *)(s)++ = (byte);              \
 } STMT_END
 
     } else *(U8 *)(s)++ = (byte);              \
 } STMT_END
 
@@ -683,85 +413,87 @@ 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");     \
     }                                                          \
     str += retlen;                                             \
 } STMT_END
 
        *cur = '\0';                                            \
        Perl_croak(aTHX_ "Malformed UTF-8 string in pack");     \
     }                                                          \
     str += retlen;                                             \
 } STMT_END
 
+static const char *_action( const tempsym_t* symptr )
+{
+    return (const char *)(( symptr->flags & FLAG_PACK ) ? "pack" : "unpack");
+}
+
 /* 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)) {
 
     while (next_symbol(symptr)) {
-       I32 len;
-       int star, size;
-       int which = (symptr->code & TYPE_IS_SHRIEKING) ?
-           PACK_SIZE_SHRIEKING : PACK_SIZE_NORMAL;
-       int offset = TYPE_NO_MODIFIERS(symptr->code) - packsize[which].first;
+       SSize_t len, size;
 
         switch (symptr->howlen) {
 
         switch (symptr->howlen) {
-        case e_star:
+         case e_star:
            Perl_croak(aTHX_ "Within []-length '*' not allowed in %s",
            Perl_croak(aTHX_ "Within []-length '*' not allowed in %s",
-                       symptr->flags & FLAG_PACK ? "pack" : "unpack" );
-            break;
+                        _action( symptr ) );
+
          default:
            /* e_no_len and e_number */
            len = symptr->length;
            break;
         }
 
          default:
            /* e_no_len and e_number */
            len = symptr->length;
            break;
         }
 
-       if ((offset >= 0) && (offset < packsize[which].size))
-           size = packsize[which].array[offset] & PACK_SIZE_MASK;
-       else
-           size = 0;
-
+       size = packprops[TYPE_NO_ENDIANNESS(symptr->code)] & PACK_SIZE_MASK;
        if (!size) {
        if (!size) {
+            SSize_t star;
            /* endianness doesn't influence the size of a type */
            switch(TYPE_NO_ENDIANNESS(symptr->code)) {
            default:
                Perl_croak(aTHX_ "Invalid type '%c' in %s",
                           (int)TYPE_NO_MODIFIERS(symptr->code),
            /* endianness doesn't influence the size of a type */
            switch(TYPE_NO_ENDIANNESS(symptr->code)) {
            default:
                Perl_croak(aTHX_ "Invalid type '%c' in %s",
                           (int)TYPE_NO_MODIFIERS(symptr->code),
-                          symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                           _action( symptr ) );
+           case '.' | TYPE_IS_SHRIEKING:
+           case '@' | TYPE_IS_SHRIEKING:
            case '@':
            case '@':
+           case '.':
            case '/':
            case 'U':                   /* XXXX Is it correct? */
            case 'w':
            case 'u':
                Perl_croak(aTHX_ "Within []-length '%c' not allowed in %s",
            case '/':
            case 'U':                   /* XXXX Is it correct? */
            case 'w':
            case 'u':
                Perl_croak(aTHX_ "Within []-length '%c' not allowed in %s",
-                          (int)symptr->code,
-                          symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                          (int) TYPE_NO_MODIFIERS(symptr->code),
+                           _action( symptr ) );
            case '%':
                size = 0;
                break;
            case '(':
            case '%':
                size = 0;
                break;
            case '(':
-               {
-                   tempsym_t savsym = *symptr;
-                   symptr->patptr = savsym.grpbeg;
-                   symptr->patend = savsym.grpend;
-                   /* XXXX Theoretically, we need to measure many times at
-                      different positions, since the subexpression may contain
-                      alignment commands, but be not of aligned length.
-                      Need to detect this and croak().  */
-                   size = measure_struct(symptr);
-                   *symptr = savsym;
-                   break;
-               }
+           {
+               tempsym_t savsym = *symptr;
+               symptr->patptr = savsym.grpbeg;
+               symptr->patend = savsym.grpend;
+               /* XXXX Theoretically, we need to measure many times at
+                  different positions, since the subexpression may contain
+                  alignment commands, but be not of aligned length.
+                  Need to detect this and croak().  */
+               size = measure_struct(symptr);
+               *symptr = savsym;
+               break;
+           }
            case 'X' | TYPE_IS_SHRIEKING:
                /* XXXX Is this useful?  Then need to treat MEASURE_BACKWARDS.
                 */
                if (!len)               /* Avoid division by 0 */
                    len = 1;
                len = total % len;      /* Assumed: the start is aligned. */
            case 'X' | TYPE_IS_SHRIEKING:
                /* XXXX Is this useful?  Then need to treat MEASURE_BACKWARDS.
                 */
                if (!len)               /* Avoid division by 0 */
                    len = 1;
                len = total % len;      /* Assumed: the start is aligned. */
-               /* FALL THROUGH */
+               /* FALLTHROUGH */
            case 'X':
                size = -1;
                if (total < len)
            case 'X':
                size = -1;
                if (total < len)
-                   Perl_croak(aTHX_ "'X' outside of string in %s",
-                              symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                    Perl_croak(aTHX_ "'X' outside of string in %s", _action( symptr ) );
                break;
            case 'x' | TYPE_IS_SHRIEKING:
                if (!len)               /* Avoid division by 0 */
                break;
            case 'x' | TYPE_IS_SHRIEKING:
                if (!len)               /* Avoid division by 0 */
@@ -771,7 +503,7 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
                    len = len - star;
                else
                    len = 0;
                    len = len - star;
                else
                    len = 0;
-               /* FALL THROUGH */
+               /* FALLTHROUGH */
            case 'x':
            case 'A':
            case 'Z':
            case 'x':
            case 'A':
            case 'Z':
@@ -804,11 +536,13 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
 /* locate matching closing parenthesis or bracket
  * returns char pointer to char after match, or NULL
  */
 /* locate matching closing parenthesis or bracket
  * returns char pointer to char after match, or NULL
  */
-STATIC char *
-S_group_end(pTHX_ register char *patptr, register char *patend, char ender)
+STATIC const char *
+S_group_end(pTHX_ const char *patptr, const char *patend, char ender)
 {
 {
+    PERL_ARGS_ASSERT_GROUP_END;
+
     while (patptr < patend) {
     while (patptr < patend) {
-       char c = *patptr++;
+       const char c = *patptr++;
 
        if (isSPACE(c))
            continue;
 
        if (isSPACE(c))
            continue;
@@ -825,22 +559,26 @@ S_group_end(pTHX_ register char *patptr, register char *patend, char ender)
     }
     Perl_croak(aTHX_ "No group ending character '%c' found in template",
                ender);
     }
     Perl_croak(aTHX_ "No group ending character '%c' found in template",
                ender);
-    return 0;
+    NOT_REACHED; /* NOTREACHED */
 }
 
 
 /* Convert unsigned decimal number to binary.
  * Expects a pointer to the first digit and address of length variable
  * Advances char pointer to 1st non-digit char and returns number
 }
 
 
 /* Convert unsigned decimal number to binary.
  * Expects a pointer to the first digit and address of length variable
  * Advances char pointer to 1st non-digit char and returns number
- */ 
-STATIC char *
-S_get_num(pTHX_ register char *patptr, I32 *lenptr )
+ */
+STATIC const char *
+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)) {
   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;
@@ -852,9 +590,10 @@ S_get_num(pTHX_ register char *patptr, I32 *lenptr )
 STATIC bool
 S_next_symbol(pTHX_ tempsym_t* symptr )
 {
 STATIC bool
 S_next_symbol(pTHX_ tempsym_t* symptr )
 {
-  char* patptr = symptr->patptr; 
-  char* patend = symptr->patend; 
-  const char *allowed = "";
+  const char* patptr = symptr->patptr;
+  const char* const patend = symptr->patend;
+
+  PERL_ARGS_ASSERT_NEXT_SYMBOL;
 
   symptr->flags &= ~FLAG_SLASH;
 
 
   symptr->flags &= ~FLAG_SLASH;
 
@@ -868,7 +607,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
       if (patptr < patend)
        patptr++;
     } else {
       if (patptr < patend)
        patptr++;
     } else {
-      /* We should have found a template code */ 
+      /* We should have found a template code */
       I32 code = *patptr++ & 0xFF;
       U32 inherited_modifiers = 0;
 
       I32 code = *patptr++ & 0xFF;
       U32 inherited_modifiers = 0;
 
@@ -876,22 +615,21 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
        if (((symptr->flags & FLAG_COMMA) == 0) && ckWARN(WARN_UNPACK)){
           symptr->flags |= FLAG_COMMA;
          Perl_warner(aTHX_ packWARN(WARN_UNPACK),
        if (((symptr->flags & FLAG_COMMA) == 0) && ckWARN(WARN_UNPACK)){
           symptr->flags |= FLAG_COMMA;
          Perl_warner(aTHX_ packWARN(WARN_UNPACK),
-                     "Invalid type ',' in %s",
-                      symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                     "Invalid type ',' in %s", _action( symptr ) );
         }
        continue;
       }
         }
        continue;
       }
-      
+
       /* for '(', skip to ')' */
       /* for '(', skip to ')' */
-      if (code == '(') {  
+      if (code == '(') {
         if( isDIGIT(*patptr) || *patptr == '*' || *patptr == '[' )
           Perl_croak(aTHX_ "()-group starts with a count in %s",
         if( isDIGIT(*patptr) || *patptr == '*' || *patptr == '[' )
           Perl_croak(aTHX_ "()-group starts with a count in %s",
-                     symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                        _action( symptr ) );
         symptr->grpbeg = patptr;
         patptr = 1 + ( symptr->grpend = group_end(patptr, patend, ')') );
         if( symptr->level >= MAX_SUB_TEMPLATE_LEVEL )
          Perl_croak(aTHX_ "Too deeply nested ()-groups in %s",
         symptr->grpbeg = patptr;
         patptr = 1 + ( symptr->grpend = group_end(patptr, patend, ')') );
         if( symptr->level >= MAX_SUB_TEMPLATE_LEVEL )
          Perl_croak(aTHX_ "Too deeply nested ()-groups in %s",
-                     symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                        _action( symptr ) );
       }
 
       /* look for group modifiers to inherit */
       }
 
       /* look for group modifiers to inherit */
@@ -902,13 +640,13 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
 
       /* look for modifiers */
       while (patptr < patend) {
 
       /* look for modifiers */
       while (patptr < patend) {
-        I32 modifier = 0;
+        const char *allowed;
+        I32 modifier;
         switch (*patptr) {
           case '!':
             modifier = TYPE_IS_SHRIEKING;
         switch (*patptr) {
           case '!':
             modifier = TYPE_IS_SHRIEKING;
-            allowed = SHRIEKING_ALLOWED_TYPES;
+            allowed = "sSiIlLxXnNvV@.";
             break;
             break;
-#ifdef PERL_PACK_CAN_BYTEORDER
           case '>':
             modifier = TYPE_IS_BIG_ENDIAN;
             allowed = ENDIANNESS_ALLOWED_TYPES;
           case '>':
             modifier = TYPE_IS_BIG_ENDIAN;
             allowed = ENDIANNESS_ALLOWED_TYPES;
@@ -917,8 +655,9 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
             modifier = TYPE_IS_LITTLE_ENDIAN;
             allowed = ENDIANNESS_ALLOWED_TYPES;
             break;
             modifier = TYPE_IS_LITTLE_ENDIAN;
             allowed = ENDIANNESS_ALLOWED_TYPES;
             break;
-#endif /* PERL_PACK_CAN_BYTEORDER */
           default:
           default:
+            allowed = "";
+            modifier = 0;
             break;
         }
 
             break;
         }
 
@@ -927,23 +666,21 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
 
         if (!strchr(allowed, TYPE_NO_MODIFIERS(code)))
           Perl_croak(aTHX_ "'%c' allowed only after types %s in %s", *patptr,
 
         if (!strchr(allowed, TYPE_NO_MODIFIERS(code)))
           Perl_croak(aTHX_ "'%c' allowed only after types %s in %s", *patptr,
-                     allowed, symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                        allowed, _action( symptr ) );
 
         if (TYPE_ENDIANNESS(code | modifier) == TYPE_ENDIANNESS_MASK)
           Perl_croak(aTHX_ "Can't use both '<' and '>' after type '%c' in %s",
 
         if (TYPE_ENDIANNESS(code | modifier) == TYPE_ENDIANNESS_MASK)
           Perl_croak(aTHX_ "Can't use both '<' and '>' after type '%c' in %s",
-                     (int) TYPE_NO_MODIFIERS(code),
-                     symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                     (int) TYPE_NO_MODIFIERS(code), _action( symptr ) );
         else if (TYPE_ENDIANNESS(code | modifier | inherited_modifiers) ==
                  TYPE_ENDIANNESS_MASK)
           Perl_croak(aTHX_ "Can't use '%c' in a group with different byte-order in %s",
         else if (TYPE_ENDIANNESS(code | modifier | inherited_modifiers) ==
                  TYPE_ENDIANNESS_MASK)
           Perl_croak(aTHX_ "Can't use '%c' in a group with different byte-order in %s",
-                     *patptr, symptr->flags & FLAG_PACK ? "pack" : "unpack" );
-
-        if (ckWARN(WARN_UNPACK)) {
-          if (code & modifier)
-           Perl_warner(aTHX_ packWARN(WARN_UNPACK),
-                        "Duplicate modifier '%c' after '%c' in %s",
-                        *patptr, (int) TYPE_NO_MODIFIERS(code),
-                        symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                     *patptr, _action( symptr ) );
+
+        if ((code & modifier)) {
+           Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK),
+                          "Duplicate modifier '%c' after '%c' in %s",
+                          *patptr, (int) TYPE_NO_MODIFIERS(code),
+                          _action( symptr ) );
         }
 
         code |= modifier;
         }
 
         code |= modifier;
@@ -953,7 +690,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
       /* inherit modifiers */
       code |= inherited_modifiers;
 
       /* inherit modifiers */
       code |= inherited_modifiers;
 
-      /* look for count and/or / */ 
+      /* look for count and/or / */
       if (patptr < patend) {
        if (isDIGIT(*patptr)) {
          patptr = get_num( patptr, &symptr->length );
       if (patptr < patend) {
        if (isDIGIT(*patptr)) {
          patptr = get_num( patptr, &symptr->length );
@@ -964,7 +701,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
           symptr->howlen = e_star;
 
         } else if (*patptr == '[') {
           symptr->howlen = e_star;
 
         } else if (*patptr == '[') {
-          char* lenptr = ++patptr;            
+          const char* lenptr = ++patptr;
           symptr->howlen = e_number;
           patptr = group_end( patptr, patend, ']' ) + 1;
           /* what kind of [] is it? */
           symptr->howlen = e_number;
           patptr = group_end( patptr, patend, ']' ) + 1;
           /* what kind of [] is it? */
@@ -972,7 +709,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
             lenptr = get_num( lenptr, &symptr->length );
             if( *lenptr != ']' )
               Perl_croak(aTHX_ "Malformed integer in [] in %s",
             lenptr = get_num( lenptr, &symptr->length );
             if( *lenptr != ']' )
               Perl_croak(aTHX_ "Malformed integer in [] in %s",
-                         symptr->flags & FLAG_PACK ? "pack" : "unpack");
+                            _action( symptr ) );
           } else {
             tempsym_t savsym = *symptr;
             symptr->patend = patptr-1;
           } else {
             tempsym_t savsym = *symptr;
             symptr->patend = patptr-1;
@@ -1002,7 +739,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
               if (patptr < patend &&
                   (isDIGIT(*patptr) || *patptr == '*' || *patptr == '['))
                 Perl_croak(aTHX_ "'/' does not take a repeat count in %s",
               if (patptr < patend &&
                   (isDIGIT(*patptr) || *patptr == '*' || *patptr == '['))
                 Perl_croak(aTHX_ "'/' does not take a repeat count in %s",
-                           symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+                            _action( symptr ) );
             }
             break;
          }
             }
             break;
          }
@@ -1014,31 +751,34 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
       }
 
       symptr->code = code;
       }
 
       symptr->code = code;
-      symptr->patptr = patptr; 
+      symptr->patptr = patptr;
       return TRUE;
     }
   }
       return TRUE;
     }
   }
-  symptr->patptr = patptr; 
+  symptr->patptr = patptr;
   return FALSE;
 }
 
 /*
   return FALSE;
 }
 
 /*
-   There is no way to cleanly handle the case where we should process the 
+   There is no way to cleanly handle the case where we should process the
    string per byte in its upgraded form while it's really in downgraded form
    string per byte in its upgraded form while it's really in downgraded form
-   (e.g. estimates like strend-s as an upper bound for the number of 
-   characters left wouldn't work). So if we foresee the need of this 
-   (pattern starts with U or contains U0), we want to work on the encoded 
-   version of the string. Users are advised to upgrade their pack string 
+   (e.g. estimates like strend-s as an upper bound for the number of
+   characters left wouldn't work). So if we foresee the need of this
+   (pattern starts with U or contains U0), we want to work on the encoded
+   version of the string. Users are advised to upgrade their pack string
    themselves if they need to do a lot of unpacks like this on it
 */
    themselves if they need to do a lot of unpacks like this on it
 */
-STATIC bool 
+STATIC bool
 need_utf8(const char *pat, const char *patend)
 {
     bool first = TRUE;
 need_utf8(const char *pat, const char *patend)
 {
     bool first = TRUE;
+
+    PERL_ARGS_ASSERT_NEED_UTF8;
+
     while (pat < patend) {
        if (pat[0] == '#') {
            pat++;
     while (pat < patend) {
        if (pat[0] == '#') {
            pat++;
-           pat = memchr(pat, '\n', patend-pat);
+           pat = (const char *) memchr(pat, '\n', patend-pat);
            if (!pat) return FALSE;
        } else if (pat[0] == 'U') {
            if (first || pat[1] == '0') return TRUE;
            if (!pat) return FALSE;
        } else if (pat[0] == 'U') {
            if (first || pat[1] == '0') return TRUE;
@@ -1050,10 +790,12 @@ need_utf8(const char *pat, const char *patend)
 
 STATIC char
 first_symbol(const char *pat, const char *patend) {
 
 STATIC char
 first_symbol(const char *pat, const char *patend) {
+    PERL_ARGS_ASSERT_FIRST_SYMBOL;
+
     while (pat < patend) {
        if (pat[0] != '#') return pat[0];
        pat++;
     while (pat < patend) {
        if (pat[0] != '#') return pat[0];
        pat++;
-       pat = memchr(pat, '\n', patend-pat);
+       pat = (const char *) memchr(pat, '\n', patend-pat);
        if (!pat) return 0;
        pat++;
     }
        if (!pat) return 0;
        pat++;
     }
@@ -1061,59 +803,42 @@ first_symbol(const char *pat, const char *patend) {
 }
 
 /*
 }
 
 /*
-=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_ char *pat, char *patend, char *s, char *strbeg, char *strend, char **new_s, I32 ocnt, U32 flags)
-{
-    tempsym_t sym = { 0 };
 
 
-    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(s, &len);
-       SAVEFREEPV(s);
-       strend = s + len;
-       flags |= FLAG_DO_UTF8;
-    }
+=head1 Pack and Unpack
 
 
-    if (first_symbol(pat, patend) != 'U' && (flags & FLAG_DO_UTF8))
-       flags |= FLAG_PARSE_UTF8;
+=for apidoc unpackstring
 
 
-    sym.patptr = pat;
-    sym.patend = patend;
-    sym.flags  = flags;
+The engine implementing the C<unpack()> Perl function.
 
 
-    return unpack_rec(&sym, s, s, strend, NULL );
-}
+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.
 
 
-/*
-=for apidoc unpackstring
+The C<strend> and C<patend> pointers should point to the byte following the
+last character of each string.
 
 
-The engine implementing unpack() Perl function. C<unpackstring> puts the
-extracted list items on the stack and returns the number of elements.
-Issue C<PUTBACK> before and C<SPAGAIN> after the call to this function.
+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 C<PUSHMARK> before calling it, unlike L</call_pv> for
+example).
 
 =cut */
 
 
 =cut */
 
-I32
-Perl_unpackstring(pTHX_ char *pat, char *patend, char *s, char *strend, U32 flags)
+SSize_t
+Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, const char *strend, U32 flags)
 {
 {
-    tempsym_t sym = { 0 };
+    tempsym_t sym;
+
+    PERL_ARGS_ASSERT_UNPACKSTRING;
 
     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;
 
     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(s, &len);
+       s = (char *) bytes_to_utf8((U8 *) s, &len);
        SAVEFREEPV(s);
        strend = s + len;
        flags |= FLAG_DO_UTF8;
        SAVEFREEPV(s);
        strend = s + len;
        flags |= FLAG_DO_UTF8;
@@ -1122,35 +847,36 @@ Perl_unpackstring(pTHX_ char *pat, char *patend, char *s, char *strend, U32 flag
     if (first_symbol(pat, patend) != 'U' && (flags & FLAG_DO_UTF8))
        flags |= FLAG_PARSE_UTF8;
 
     if (first_symbol(pat, patend) != 'U' && (flags & FLAG_DO_UTF8))
        flags |= FLAG_PARSE_UTF8;
 
-    sym.patptr = pat;
-    sym.patend = patend;
-    sym.flags  = flags;
+    TEMPSYM_INIT(&sym, pat, patend, flags);
 
     return unpack_rec(&sym, s, s, strend, NULL );
 }
 
 
     return unpack_rec(&sym, s, s, strend, NULL );
 }
 
-STATIC
-I32
-S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char **new_s )
+STATIC SSize_t
+S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
 {
     dSP;
 {
     dSP;
-    SV *sv;
-    I32 start_sp_offset = SP - PL_stack_base;
+    SV *sv = NULL;
+    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);
-    char* strrelbeg = s;
+    const SSize_t bits_in_uv = CHAR_BIT * sizeof(cuv);
     bool beyond = FALSE;
     bool explicit_length;
     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;
 
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
 
+    PERL_ARGS_ASSERT_UNPACK_REC;
+
+    symptr->strbeg = s - strbeg;
+
     while (next_symbol(symptr)) {
     while (next_symbol(symptr)) {
-       I32 len, ai32;
+       packprops_t props;
+       SSize_t len;
         I32 datumtype = symptr->code;
         I32 datumtype = symptr->code;
+        bool needs_swap;
        /* do first one only unless in list context
           / is implemented by unpacking the count, then popping it from the
           stack, so must check that we're not in the middle of a /  */
        /* do first one only unless in list context
           / is implemented by unpacking the count, then popping it from the
           stack, so must check that we're not in the middle of a /  */
@@ -1160,8 +886,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
             break;
 
         switch (howlen = symptr->howlen) {
             break;
 
         switch (howlen = symptr->howlen) {
-        case e_star:
-           len = strend - strbeg;      /* long enough */          
+         case e_star:
+           len = strend - strbeg;      /* long enough */
            break;
          default:
            /* e_no_len and e_number */
            break;
          default:
            /* e_no_len and e_number */
@@ -1172,32 +898,24 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
         explicit_length = TRUE;
       redo_switch:
         beyond = s >= strend;
         explicit_length = TRUE;
       redo_switch:
         beyond = s >= strend;
-       {
-           struct packsize_t *pack_props =
-               &packsize[(symptr->code & TYPE_IS_SHRIEKING) ?
-                         PACK_SIZE_SHRIEKING : PACK_SIZE_NORMAL];
-           const int rawtype = TYPE_NO_MODIFIERS(datumtype);
-           int offset = rawtype - pack_props->first;
-
-           if (offset >= 0 && offset < pack_props->size) {
-               /* Data about this template letter  */
-               unsigned char data = pack_props->array[offset];
-
-               if (data) {
-                   /* data nonzero means we can process this letter.  */
-                   long size = data & PACK_SIZE_MASK;
-                   long howmany = (strend - s) / size;
-                   if (len > howmany)
-                       len = howmany;
-
-                   if (!checksum || (data & PACK_SIZE_CANNOT_CSUM)) {
-                       if (len && unpack_only_one) len = 1;
-                       EXTEND(SP, len);
-                       EXTEND_MORTAL(len);
-                   }
-               }
+
+       props = packprops[TYPE_NO_ENDIANNESS(datumtype)];
+       if (props) {
+           /* props nonzero means we can process this letter. */
+            const SSize_t size = props & PACK_SIZE_MASK;
+            const SSize_t howmany = (strend - s) / size;
+           if (len > howmany)
+               len = howmany;
+
+           if (!checksum || (props & PACK_SIZE_CANNOT_CSUM)) {
+               if (len && unpack_only_one) len = 1;
+               EXTEND(SP, len);
+               EXTEND_MORTAL(len);
            }
        }
            }
        }
+
+        needs_swap = NEEDS_SWAP(datumtype);
+
        switch(TYPE_NO_ENDIANNESS(datumtype)) {
        default:
            Perl_croak(aTHX_ "Invalid type '%c' in unpack", (int)TYPE_NO_MODIFIERS(datumtype) );
        switch(TYPE_NO_ENDIANNESS(datumtype)) {
        default:
            Perl_croak(aTHX_ "Invalid type '%c' in unpack", (int)TYPE_NO_MODIFIERS(datumtype) );
@@ -1209,15 +927,17 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            cuv = 0;
            cdouble = 0;
            continue;
            cuv = 0;
            cdouble = 0;
            continue;
-           break;
+
        case '(':
        {
             tempsym_t savsym = *symptr;
        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->flags |= group_modifiers;
             symptr->patend = savsym.grpend;
+           symptr->previous = &savsym;
             symptr->level++;
            PUTBACK;
             symptr->level++;
            PUTBACK;
+           if (len && unpack_only_one) len = 1;
            while (len--) {
                symptr->patptr = savsym.grpbeg;
                if (utf8) symptr->flags |=  FLAG_PARSE_UTF8;
            while (len--) {
                symptr->patptr = savsym.grpbeg;
                if (utf8) symptr->flags |=  FLAG_PARSE_UTF8;
@@ -1227,14 +947,34 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                    break; /* No way to continue */
            }
            SPAGAIN;
                    break; /* No way to continue */
            }
            SPAGAIN;
-           symptr->flags &= ~group_modifiers;
-            savsym.flags = symptr->flags;
+            savsym.flags = symptr->flags & ~group_modifiers;
             *symptr = savsym;
            break;
        }
             *symptr = savsym;
            break;
        }
+       case '.' | TYPE_IS_SHRIEKING:
+       case '.': {
+           const char *from;
+           SV *sv;
+           const bool u8 = utf8 && !(datumtype & TYPE_IS_SHRIEKING);
+           if (howlen == e_star) from = strbeg;
+           else if (len <= 0) from = s;
+           else {
+               tempsym_t *group = symptr;
+
+               while (--len && group) group = group->previous;
+               from = group ? strbeg + group->strbeg : strbeg;
+           }
+           sv = 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)));
+           mXPUSHs(sv);
+           break;
+       }
+       case '@' | TYPE_IS_SHRIEKING:
        case '@':
        case '@':
-           if (utf8) {
-               s = strrelbeg;
+           s = strbeg + symptr->strbeg;
+           if (utf8  && !(datumtype & TYPE_IS_SHRIEKING))
+           {
                while (len > 0) {
                    if (s >= strend)
                        Perl_croak(aTHX_ "'@' outside of string in unpack");
                while (len > 0) {
                    if (s >= strend)
                        Perl_croak(aTHX_ "'@' outside of string in unpack");
@@ -1244,17 +984,17 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                if (s > strend)
                    Perl_croak(aTHX_ "'@' outside of string with malformed UTF-8 in unpack");
            } else {
                if (s > strend)
                    Perl_croak(aTHX_ "'@' outside of string with malformed UTF-8 in unpack");
            } else {
-           if (len > strend - strrelbeg)
-               Perl_croak(aTHX_ "'@' outside of string in unpack");
-           s = strrelbeg + len;
+               if (strend-s < len)
+                   Perl_croak(aTHX_ "'@' outside of string in unpack");
+               s += len;
            }
            break;
        case 'X' | TYPE_IS_SHRIEKING:
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) {
            }
            break;
        case 'X' | TYPE_IS_SHRIEKING:
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) {
-               char *hop, *last;
-               I32 l = len;
+               const char *hop, *last;
+               SSize_t l = len;
                hop = last = strbeg;
                while (hop < s) {
                    hop += UTF8SKIP(hop);
                hop = last = strbeg;
                while (hop < s) {
                    hop += UTF8SKIP(hop);
@@ -1262,14 +1002,14 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                        last = hop;
                        l = len;
                    }
                        last = hop;
                        l = len;
                    }
-                   }
+               }
                if (last > s)
                    Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                s = last;
                break;
            }
            len = (s - strbeg) % len;
                if (last > s)
                    Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                s = last;
                break;
            }
            len = (s - strbeg) % len;
-           /* FALL THROUGH */
+           /* FALLTHROUGH */
        case 'X':
            if (utf8) {
                while (len > 0) {
        case 'X':
            if (utf8) {
                while (len > 0) {
@@ -1282,19 +1022,21 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                    len--;
                }
            } else {
                    len--;
                }
            } else {
-           if (len > s - strbeg)
-               Perl_croak(aTHX_ "'X' outside of string in unpack" );
-           s -= len;
+               if (len > s - strbeg)
+                   Perl_croak(aTHX_ "'X' outside of string in unpack" );
+               s -= len;
            }
            break;
            }
            break;
-       case 'x' | TYPE_IS_SHRIEKING:
+       case 'x' | TYPE_IS_SHRIEKING: {
+            SSize_t ai32;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
-           if (utf8) ai32 = utf8_length(strbeg, s) % len;
-           else      ai32 = (s - strbeg)           % len;
+           if (utf8) ai32 = utf8_length((U8 *) strbeg, (U8 *) s) % len;
+           else      ai32 = (s - strbeg)                         % len;
            if (ai32 == 0) break;
            len -= ai32;
            if (ai32 == 0) break;
            len -= ai32;
-           /* FALL THROUGH */
+            }
+           /* FALLTHROUGH */
        case 'x':
            if (utf8) {
                while (len>0) {
        case 'x':
            if (utf8) {
                while (len>0) {
@@ -1304,14 +1046,14 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                    len--;
                }
            } else {
                    len--;
                }
            } else {
-           if (len > strend - s)
-               Perl_croak(aTHX_ "'x' outside of string in unpack");
-           s += len;
+               if (len > strend - s)
+                   Perl_croak(aTHX_ "'x' outside of string in unpack");
+               s += len;
            }
            break;
        case '/':
            Perl_croak(aTHX_ "'/' must follow a numeric type in unpack");
            }
            break;
        case '/':
            Perl_croak(aTHX_ "'/' must follow a numeric type in unpack");
-            break;
+
        case 'A':
        case 'Z':
        case 'a':
        case 'A':
        case 'Z':
        case 'a':
@@ -1321,14 +1063,14 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                goto W_checksum;
            }
            if (utf8) {
                goto W_checksum;
            }
            if (utf8) {
-               I32 l;
-               char *hop;
+               SSize_t l;
+               const char *hop;
                for (l=len, hop=s; l>0; l--, hop += UTF8SKIP(hop)) {
                    if (hop >= strend) {
                        if (hop > strend)
                            Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                        break;
                for (l=len, hop=s; l>0; l--, hop += UTF8SKIP(hop)) {
                    if (hop >= strend) {
                        if (hop > strend)
                            Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                        break;
-               }
+                   }
                }
                if (hop > strend)
                    Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                }
                if (hop > strend)
                    Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
@@ -1338,7 +1080,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 
            if (datumtype == 'Z') {
                /* 'Z' strips stuff after first null */
 
            if (datumtype == 'Z') {
                /* 'Z' strips stuff after first null */
-               char *ptr, *end;
+               const char *ptr, *end;
                end = s + len;
                for (ptr = s; ptr < end; ptr++) if (*ptr == 0) break;
                sv = newSVpvn(s, ptr-s);
                end = s + len;
                for (ptr = s; ptr < end; ptr++) if (*ptr == 0) break;
                sv = newSVpvn(s, ptr-s);
@@ -1346,10 +1088,25 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                    len = ptr-s + (ptr != strend ? 1 : 0);
            } else if (datumtype == 'A') {
                /* 'A' strips both nulls and spaces */
                    len = ptr-s + (ptr != strend ? 1 : 0);
            } else if (datumtype == 'A') {
                /* 'A' strips both nulls and spaces */
-               char *ptr;
-               for (ptr = s+len-1; ptr >= s; ptr--)
-                   if (*ptr != 0 && !isSPACE(*ptr)) break;
-               ptr++;
+               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_safe(ptr, strend))
+                        {
+                            break;
+                        }
+                    }
+                   if (ptr >= s) ptr += UTF8SKIP(ptr);
+                   else ptr++;
+                   if (ptr > s+len)
+                       Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
+               } else {
+                   for (ptr = s+len-1; ptr >= s; ptr--)
+                       if (*ptr != 0 && !isSPACE(*ptr)) break;
+                   ptr++;
+               }
                sv = newSVpvn(s, ptr-s);
            } else sv = newSVpvn(s, len);
 
                sv = newSVpvn(s, ptr-s);
            } else sv = newSVpvn(s, len);
 
@@ -1359,7 +1116,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                if (!(symptr->flags & FLAG_WAS_UTF8))
                    sv_utf8_downgrade(sv, 0);
            }
                if (!(symptr->flags & FLAG_WAS_UTF8))
                    sv_utf8_downgrade(sv, 0);
            }
-           XPUSHs(sv_2mortal(sv));
+           mXPUSHs(sv);
            s += len;
            break;
        case 'B':
            s += len;
            break;
        case 'B':
@@ -1368,30 +1125,16 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            if (howlen == e_star || len > (strend - s) * 8)
                len = (strend - s) * 8;
            if (checksum) {
            if (howlen == e_star || len > (strend - s) * 8)
                len = (strend - s) * 8;
            if (checksum) {
-               if (!PL_bitcount) {
-                   int bits;
-                   Newz(601, PL_bitcount, 256, char);
-                   for (bits = 1; bits < 256; bits++) {
-                       if (bits & 1)   PL_bitcount[bits]++;
-                       if (bits & 2)   PL_bitcount[bits]++;
-                       if (bits & 4)   PL_bitcount[bits]++;
-                       if (bits & 8)   PL_bitcount[bits]++;
-                       if (bits & 16)  PL_bitcount[bits]++;
-                       if (bits & 32)  PL_bitcount[bits]++;
-                       if (bits & 64)  PL_bitcount[bits]++;
-                       if (bits & 128) PL_bitcount[bits]++;
-                   }
-               }
                if (utf8)
                    while (len >= 8 && s < strend) {
                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
-               while (len >= 8) {
+                   while (len >= 8) {
                        cuv += PL_bitcount[*(U8 *)s++];
                        cuv += PL_bitcount[*(U8 *)s++];
-                   len -= 8;
-               }
+                       len -= 8;
+                   }
                if (len && s < strend) {
                    U8 bits;
                    bits = SHIFT_BYTE(utf8, s, strend, datumtype);
                if (len && s < strend) {
                    U8 bits;
                    bits = SHIFT_BYTE(utf8, s, strend, datumtype);
@@ -1405,122 +1148,137 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                            if (bits & 0x80) cuv++;
                            bits <<= 1;
                        }
                            if (bits & 0x80) cuv++;
                            bits <<= 1;
                        }
-                   }
+               }
                break;
            }
 
                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') {
                U8 bits = 0;
            SvPOK_on(sv);
            str = SvPVX(sv);
            if (datumtype == 'b') {
                U8 bits = 0;
-               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;
-               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';
                }
            }
            *str = '\0';
                    } else bits = *(U8 *) s++;
                    *str++ = bits & 0x80 ? '1' : '0';
                }
            }
            *str = '\0';
-           SvCUR_set(sv, str - SvPVX(sv));
+           SvCUR_set(sv, str - SvPVX_const(sv));
            XPUSHs(sv);
            break;
        }
        case 'H':
        case 'h': {
            XPUSHs(sv);
            break;
        }
        case 'H':
        case 'h': {
-           char *str;
-             /* Preliminary length estimate, acceptable for utf8 too */
+           char *str = NULL;
+           /* Preliminary length estimate, acceptable for utf8 too */
            if (howlen == e_star || len > (strend - s) * 2)
                len = (strend - s) * 2;
            if (howlen == e_star || len > (strend - s) * 2)
                len = (strend - s) * 2;
-             sv = sv_2mortal(NEWSV(35, len ? len : 1));
-           SvPOK_on(sv);
-           str = SvPVX(sv);
+           if (!checksum) {
+               sv = sv_2mortal(newSV(len ? len : 1));
+               SvPOK_on(sv);
+               str = SvPVX(sv);
+           }
            if (datumtype == 'h') {
                U8 bits = 0;
            if (datumtype == 'h') {
                U8 bits = 0;
-                 ai32 = len;
-                 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);
-                     } else bits = * (U8 *) s++;
-                   *str++ = PL_hexdigit[bits & 15];
+               SSize_t ai32 = len;
+               for (len = 0; len < ai32; len++) {
+                   if (len & 1) bits >>= 4;
+                   else if (utf8) {
+                       if (s >= strend) break;
+                       bits = utf8_to_byte(aTHX_ &s, strend, datumtype);
+                   } else bits = * (U8 *) s++;
+                   if (!checksum)
+                       *str++ = PL_hexdigit[bits & 15];
                }
            } else {
                U8 bits = 0;
                }
            } else {
                U8 bits = 0;
-               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++;
                    } else bits = *(U8 *) s++;
-                   *str++ = PL_hexdigit[(bits >> 4) & 15];
+                   if (!checksum)
+                       *str++ = PL_hexdigit[(bits >> 4) & 15];
                }
            }
                }
            }
-           *str = '\0';
-           SvCUR_set(sv, str - SvPVX(sv));
-           XPUSHs(sv);
+           if (!checksum) {
+               *str = '\0';
+               SvCUR_set(sv, str - SvPVX_const(sv));
+               XPUSHs(sv);
+           }
            break;
        }
            break;
        }
+       case 'C':
+            if (len == 0) {
+                if (explicit_length)
+                   /* Switch to "character" mode */
+                   utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0;
+               break;
+           }
+           /* FALLTHROUGH */
        case 'c':
        case 'c':
-           while (len-- > 0) {
-               int aint = SHIFT_BYTE(utf8, s, strend, datumtype);
-               if (aint >= 128)        /* fake up signed chars */
+           while (len-- > 0 && s < strend) {
+               int aint;
+               if (utf8)
+                 {
+                   STRLEN retlen;
+                   aint = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
+                                ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+                   if (retlen == (STRLEN) -1)
+                       Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
+                   s += retlen;
+                 }
+               else
+                 aint = *(U8 *)(s)++;
+               if (aint >= 128 && datumtype != 'C')    /* fake up signed chars */
                    aint -= 256;
                if (!checksum)
                    aint -= 256;
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)aint)));
+                   mPUSHi(aint);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aint;
                else
                    cuv += aint;
            }
            break;
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aint;
                else
                    cuv += aint;
            }
            break;
-       case 'C':
        case 'W':
          W_checksum:
        case 'W':
          W_checksum:
-            if (len == 0) {
-                if (explicit_length && datumtype == 'C') 
-                   /* Switch to "character" mode */
-                   utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0;
-               break;
-           }
-           if (datumtype == 'C' ? 
-                (symptr->flags & FLAG_DO_UTF8) &&
-               !(symptr->flags & FLAG_WAS_UTF8) : utf8) {
+           if (utf8) {
                while (len-- > 0 && s < strend) {
                while (len-- > 0 && s < strend) {
-                   UV val;
                    STRLEN retlen;
                    STRLEN retlen;
-                   val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
+                   const UV val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
                                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
                                         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)
-                       PUSHs(sv_2mortal(newSVuv((UV) val)));
+                       mPUSHu(val);
                    else if (checksum > bits_in_uv)
                        cdouble += (NV) val;
                    else
                        cuv += val;
                    else if (checksum > bits_in_uv)
                        cdouble += (NV) val;
                    else
                        cuv += val;
-           }
+               }
            } else if (!checksum)
                while (len-- > 0) {
            } else if (!checksum)
                while (len-- > 0) {
-                   U8 ch = *(U8 *) s++;
-                   PUSHs(sv_2mortal(newSVuv((UV) ch)));
+                   const U8 ch = *(U8 *) s++;
+                   mPUSHu(ch);
            }
            else if (checksum > bits_in_uv)
                while (len-- > 0) cdouble += (NV) *(U8 *) s++;
            }
            else if (checksum > bits_in_uv)
                while (len-- > 0) cdouble += (NV) *(U8 *) s++;
@@ -1529,7 +1287,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            break;
        case 'U':
            if (len == 0) {
            break;
        case 'U':
            if (len == 0) {
-                if (explicit_length) {
+                if (explicit_length && howlen != e_star) {
                    /* Switch to "bytes in UTF-8" mode */
                    if (symptr->flags & FLAG_DO_UTF8) utf8 = 0;
                    else
                    /* Switch to "bytes in UTF-8" mode */
                    if (symptr->flags & FLAG_DO_UTF8) utf8 = 0;
                    else
@@ -1539,36 +1297,42 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                break;
            }
            if (len > strend - s) len = strend - s;
                break;
            }
            if (len > strend - s) len = strend - s;
-               if (!checksum) {
+           if (!checksum) {
                if (len && unpack_only_one) len = 1;
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
                if (len && unpack_only_one) len = 1;
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
-               }
+           }
            while (len-- > 0 && s < strend) {
                STRLEN retlen;
                UV auv;
                if (utf8) {
            while (len-- > 0 && s < strend) {
                STRLEN retlen;
                UV auv;
                if (utf8) {
-                   U8 result[UTF8_MAXLEN];
-                   char *ptr;
+                   U8 result[UTF8_MAXLEN+1];
+                   const char *ptr = s;
                    STRLEN len;
                    STRLEN len;
-                   ptr = s;
                    /* Bug: warns about bad utf8 even if we are short on bytes
                       and will break out of the loop */
                    /* 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, result, 1, 'U'))
+                   if (!S_utf8_to_bytes(aTHX_ &ptr, strend, (char *) result, 1,
+                                     'U'))
                        break;
                    len = UTF8SKIP(result);
                        break;
                    len = UTF8SKIP(result);
-                   if (!uni_to_bytes(aTHX_ &ptr, strend, 
-                                     &result[1], len-1, 'U')) break;
-                   auv = utf8n_to_uvuni(result, len, &retlen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV);
+                   if (!S_utf8_to_bytes(aTHX_ &ptr, strend,
+                                     (char *) &result[1], len-1, 'U')) break;
+                   auv = NATIVE_TO_UNI(utf8n_to_uvchr(result,
+                                                       len,
+                                                       &retlen,
+                                                       UTF8_ALLOW_DEFAULT));
                    s = ptr;
                } else {
                    s = ptr;
                } else {
-                   auv = utf8n_to_uvuni((U8*)s, strend - s, &retlen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV);
-                   if (retlen == (STRLEN) -1 || retlen == 0)
+                   auv = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s,
+                                                       strend - s,
+                                                       &retlen,
+                                                       UTF8_ALLOW_DEFAULT));
+                   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)
-                   PUSHs(sv_2mortal(newSVuv((UV) auv)));
+                   mPUSHu(auv);
                else if (checksum > bits_in_uv)
                    cdouble += (NV) auv;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV) auv;
                else
@@ -1579,10 +1343,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #if SHORTSIZE != SIZE16
            while (len-- > 0) {
                short ashort;
 #if SHORTSIZE != SIZE16
            while (len-- > 0) {
                short ashort;
-               SHIFT_VAR(utf8, s, strend, ashort, datumtype);
-               DO_BO_UNPACK(ashort, s);
+                SHIFT_VAR(utf8, s, strend, ashort, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)ashort)));
+                   mPUSHi(ashort);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ashort;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ashort;
                else
@@ -1590,7 +1353,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            }
            break;
 #else
            }
            break;
 #else
-           /* Fallthrough! */
+           /* FALLTHROUGH */
 #endif
        case 's':
            while (len-- > 0) {
 #endif
        case 's':
            while (len-- > 0) {
@@ -1599,14 +1362,13 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #if U16SIZE > SIZE16
                ai16 = 0;
 #endif
 #if U16SIZE > SIZE16
                ai16 = 0;
 #endif
-               SHIFT16(utf8, s, strend, &ai16, datumtype);
-               DO_BO_UNPACK(ai16, 16);
+                SHIFT16(utf8, s, strend, &ai16, datumtype, needs_swap);
 #if U16SIZE > SIZE16
                if (ai16 > 32767)
                    ai16 -= 65536;
 #endif
                if (!checksum)
 #if U16SIZE > SIZE16
                if (ai16 > 32767)
                    ai16 -= 65536;
 #endif
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)ai16)));
+                   mPUSHi(ai16);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ai16;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ai16;
                else
@@ -1617,10 +1379,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #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);
-               DO_BO_UNPACK(aushort, s);
+               SHIFT_VAR(utf8, s, strend, aushort, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVuv((UV) aushort)));
+                   mPUSHu(aushort);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aushort;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aushort;
                else
@@ -1628,7 +1389,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            }
            break;
 #else
            }
            break;
 #else
-            /* Fallhrough! */
+            /* FALLTHROUGH */
 #endif
        case 'v':
        case 'n':
 #endif
        case 'v':
        case 'n':
@@ -1638,25 +1399,19 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #if U16SIZE > SIZE16
                au16 = 0;
 #endif
 #if U16SIZE > SIZE16
                au16 = 0;
 #endif
-               SHIFT16(utf8, s, strend, &au16, datumtype);
-               DO_BO_UNPACK(au16, 16);
-#ifdef HAS_NTOHS
+                SHIFT16(utf8, s, strend, &au16, datumtype, needs_swap);
                if (datumtype == 'n')
                    au16 = PerlSock_ntohs(au16);
                if (datumtype == 'n')
                    au16 = PerlSock_ntohs(au16);
-#endif
-#ifdef HAS_VTOHS
                if (datumtype == 'v')
                    au16 = vtohs(au16);
                if (datumtype == 'v')
                    au16 = vtohs(au16);
-#endif
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVuv((UV)au16)));
+                   mPUSHu(au16);
                else if (checksum > bits_in_uv)
                    cdouble += (NV) au16;
                else
                    cuv += au16;
            }
            break;
                else if (checksum > bits_in_uv)
                    cdouble += (NV) au16;
                else
                    cuv += au16;
            }
            break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
        case 'v' | TYPE_IS_SHRIEKING:
        case 'n' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
        case 'v' | TYPE_IS_SHRIEKING:
        case 'n' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
@@ -1664,32 +1419,28 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 # if U16SIZE > SIZE16
                ai16 = 0;
 # endif
 # if U16SIZE > SIZE16
                ai16 = 0;
 # endif
-               SHIFT16(utf8, s, strend, &ai16, datumtype);
-# ifdef HAS_NTOHS
+                SHIFT16(utf8, s, strend, &ai16, datumtype, needs_swap);
+                /* There should never be any byte-swapping here.  */
+                assert(!TYPE_ENDIANNESS(datumtype));
                if (datumtype == ('n' | TYPE_IS_SHRIEKING))
                    ai16 = (I16) PerlSock_ntohs((U16) ai16);
                if (datumtype == ('n' | TYPE_IS_SHRIEKING))
                    ai16 = (I16) PerlSock_ntohs((U16) ai16);
-# endif /* HAS_NTOHS */
-# ifdef HAS_VTOHS
                if (datumtype == ('v' | TYPE_IS_SHRIEKING))
                    ai16 = (I16) vtohs((U16) ai16);
                if (datumtype == ('v' | TYPE_IS_SHRIEKING))
                    ai16 = (I16) vtohs((U16) ai16);
-# endif /* HAS_VTOHS */
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)ai16)));
+                   mPUSHi(ai16);
                else if (checksum > bits_in_uv)
                    cdouble += (NV) ai16;
                else
                    cuv += ai16;
            }
            break;
                else if (checksum > bits_in_uv)
                    cdouble += (NV) ai16;
                else
                    cuv += ai16;
            }
            break;
-#endif /* PERL_PACK_CAN_SHRIEKSIGN */
        case 'i':
        case 'i' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
                int aint;
        case 'i':
        case 'i' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
                int aint;
-               SHIFT_VAR(utf8, s, strend, aint, datumtype);
-               DO_BO_UNPACK(aint, i);
+                SHIFT_VAR(utf8, s, strend, aint, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)aint)));
+                   mPUSHi(aint);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aint;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aint;
                else
@@ -1700,10 +1451,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
        case 'I' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
                unsigned int auint;
        case 'I' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
                unsigned int auint;
-               SHIFT_VAR(utf8, s, strend, auint, datumtype);
-               DO_BO_UNPACK(auint, i);
+                SHIFT_VAR(utf8, s, strend, auint, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVuv((UV)auint)));
+                   mPUSHu(auint);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)auint;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)auint;
                else
@@ -1713,18 +1463,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
        case 'j':
            while (len-- > 0) {
                IV aiv;
        case 'j':
            while (len-- > 0) {
                IV aiv;
-               SHIFT_VAR(utf8, s, strend, aiv, datumtype);
-#if IVSIZE == INTSIZE
-               DO_BO_UNPACK(aiv, i);
-#elif IVSIZE == LONGSIZE
-               DO_BO_UNPACK(aiv, l);
-#elif defined(HAS_QUAD) && IVSIZE == U64SIZE
-               DO_BO_UNPACK(aiv, 64);
-#else
-               Perl_croak(aTHX_ "'j' not supported on this platform");
-#endif
+                SHIFT_VAR(utf8, s, strend, aiv, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv(aiv)));
+                   mPUSHi(aiv);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aiv;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aiv;
                else
@@ -1734,18 +1475,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
        case 'J':
            while (len-- > 0) {
                UV auv;
        case 'J':
            while (len-- > 0) {
                UV auv;
-               SHIFT_VAR(utf8, s, strend, auv, datumtype);
-#if IVSIZE == INTSIZE
-               DO_BO_UNPACK(auv, i);
-#elif IVSIZE == LONGSIZE
-               DO_BO_UNPACK(auv, l);
-#elif defined(HAS_QUAD) && IVSIZE == U64SIZE
-               DO_BO_UNPACK(auv, 64);
-#else
-               Perl_croak(aTHX_ "'J' not supported on this platform");
-#endif
+                SHIFT_VAR(utf8, s, strend, auv, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVuv(auv)));
+                   mPUSHu(auv);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)auv;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)auv;
                else
@@ -1756,10 +1488,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #if LONGSIZE != SIZE32
            while (len-- > 0) {
                long along;
 #if LONGSIZE != SIZE32
            while (len-- > 0) {
                long along;
-               SHIFT_VAR(utf8, s, strend, along, datumtype);
-               DO_BO_UNPACK(along, l);
+                SHIFT_VAR(utf8, s, strend, along, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)along)));
+                   mPUSHi(along);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)along;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)along;
                else
@@ -1767,7 +1498,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            }
            break;
 #else
            }
            break;
 #else
-           /* Fallthrough! */
+           /* FALLTHROUGH */
 #endif
        case 'l':
            while (len-- > 0) {
 #endif
        case 'l':
            while (len-- > 0) {
@@ -1775,13 +1506,12 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #if U32SIZE > SIZE32
                ai32 = 0;
 #endif
 #if U32SIZE > SIZE32
                ai32 = 0;
 #endif
-               SHIFT32(utf8, s, strend, &ai32, datumtype);
-               DO_BO_UNPACK(ai32, 32);
+                SHIFT32(utf8, s, strend, &ai32, datumtype, needs_swap);
 #if U32SIZE > SIZE32
                if (ai32 > 2147483647) ai32 -= 4294967296;
 #endif
                if (!checksum)
 #if U32SIZE > SIZE32
                if (ai32 > 2147483647) ai32 -= 4294967296;
 #endif
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)ai32)));
+                   mPUSHi(ai32);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ai32;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ai32;
                else
@@ -1792,10 +1522,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #if LONGSIZE != SIZE32
            while (len-- > 0) {
                unsigned long aulong;
 #if LONGSIZE != SIZE32
            while (len-- > 0) {
                unsigned long aulong;
-               SHIFT_VAR(utf8, s, strend, aulong, datumtype);
-               DO_BO_UNPACK(aulong, l);
+                SHIFT_VAR(utf8, s, strend, aulong, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVuv((UV)aulong)));
+                   mPUSHu(aulong);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aulong;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aulong;
                else
@@ -1803,7 +1532,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            }
            break;
 #else
            }
            break;
 #else
-            /* Fall through! */
+            /* FALLTHROUGH */
 #endif
        case 'V':
        case 'N':
 #endif
        case 'V':
        case 'N':
@@ -1813,81 +1542,72 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
 #if U32SIZE > SIZE32
                au32 = 0;
 #endif
 #if U32SIZE > SIZE32
                au32 = 0;
 #endif
-               SHIFT32(utf8, s, strend, &au32, datumtype);
-               DO_BO_UNPACK(au32, 32);
-#ifdef HAS_NTOHL
+                SHIFT32(utf8, s, strend, &au32, datumtype, needs_swap);
                if (datumtype == 'N')
                    au32 = PerlSock_ntohl(au32);
                if (datumtype == 'N')
                    au32 = PerlSock_ntohl(au32);
-#endif
-#ifdef HAS_VTOHL
                if (datumtype == 'V')
                    au32 = vtohl(au32);
                if (datumtype == 'V')
                    au32 = vtohl(au32);
-#endif
                if (!checksum)
                if (!checksum)
-                    PUSHs(sv_2mortal(newSVuv((UV)au32)));
-                else if (checksum > bits_in_uv)
-                    cdouble += (NV)au32;
-                else
-                    cuv += au32;
+                   mPUSHu(au32);
+               else if (checksum > bits_in_uv)
+                   cdouble += (NV)au32;
+               else
+                   cuv += au32;
            }
            break;
            }
            break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
        case 'V' | TYPE_IS_SHRIEKING:
        case 'N' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
                I32 ai32;
        case 'V' | TYPE_IS_SHRIEKING:
        case 'N' | TYPE_IS_SHRIEKING:
            while (len-- > 0) {
                I32 ai32;
-# if U32SIZE > SIZE32
+#if U32SIZE > SIZE32
                ai32 = 0;
                ai32 = 0;
-# endif
-               SHIFT32(utf8, s, strend, &ai32, datumtype);
-# ifdef HAS_NTOHL
+#endif
+                SHIFT32(utf8, s, strend, &ai32, datumtype, needs_swap);
+                /* There should never be any byte swapping here.  */
+                assert(!TYPE_ENDIANNESS(datumtype));
                if (datumtype == ('N' | TYPE_IS_SHRIEKING))
                    ai32 = (I32)PerlSock_ntohl((U32)ai32);
                if (datumtype == ('N' | TYPE_IS_SHRIEKING))
                    ai32 = (I32)PerlSock_ntohl((U32)ai32);
-# endif
-# ifdef HAS_VTOHL
                if (datumtype == ('V' | TYPE_IS_SHRIEKING))
                    ai32 = (I32)vtohl((U32)ai32);
                if (datumtype == ('V' | TYPE_IS_SHRIEKING))
                    ai32 = (I32)vtohl((U32)ai32);
-# endif
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSViv((IV)ai32)));
+                   mPUSHi(ai32);
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ai32;
                else
                    cuv += ai32;
            }
            break;
                else if (checksum > bits_in_uv)
                    cdouble += (NV)ai32;
                else
                    cuv += ai32;
            }
            break;
-#endif /* PERL_PACK_CAN_SHRIEKSIGN */
        case 'p':
            while (len-- > 0) {
        case 'p':
            while (len-- > 0) {
-               char *aptr;
-               SHIFT_VAR(utf8, s, strend, aptr, datumtype);
-               DO_BO_UNPACK_P(aptr);
+               const char *aptr;
+                SHIFT_VAR(utf8, s, strend, aptr, datumtype, needs_swap);
                /* newSVpv generates undef if aptr is NULL */
                /* newSVpv generates undef if aptr is NULL */
-               PUSHs(sv_2mortal(newSVpv(aptr, 0)));
+               mPUSHs(newSVpv(aptr, 0));
            }
            break;
        case 'w':
            {
                UV auv = 0;
            }
            break;
        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;
                    if (ch < 0x80) {
                        bytes = 0;
-                       PUSHs(sv_2mortal(newSVuv(auv)));
+                       mPUSHu(auv);
                        len--;
                        auv = 0;
                        continue;
                    }
                    if (++bytes >= sizeof(UV)) {        /* promote to string */
                        len--;
                        auv = 0;
                        continue;
                    }
                    if (++bytes >= sizeof(UV)) {        /* promote to string */
-                       char *t;
-                       STRLEN n_a;
+                       const char *t;
 
 
-                       sv = Perl_newSVpvf(aTHX_ "%.*"UVf, (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));
@@ -1896,11 +1616,11 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                                break;
                            }
                        }
                                break;
                            }
                        }
-                       t = SvPV(sv, n_a);
+                       t = SvPV_nolen_const(sv);
                        while (*t == '0')
                            t++;
                        sv_chop(sv, t);
                        while (*t == '0')
                            t++;
                        sv_chop(sv, t);
-                       PUSHs(sv_2mortal(sv));
+                       mPUSHs(sv);
                        len--;
                        auv = 0;
                    }
                        len--;
                        auv = 0;
                    }
@@ -1913,23 +1633,20 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
            if (symptr->howlen == e_star)
                Perl_croak(aTHX_ "'P' must have an explicit size in unpack");
            EXTEND(SP, 1);
            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;
                char *aptr;
-               SHIFT_VAR(utf8, s, strend, aptr, datumtype);
-               DO_BO_UNPACK_P(aptr);
-           /* newSVpvn generates undef if aptr is NULL */
-           PUSHs(sv_2mortal(newSVpvn(aptr, len)));
+                SHIFT_VAR(utf8, s, strend, aptr, datumtype, needs_swap);
+               /* newSVpvn generates undef if aptr is NULL */
+               PUSHs(newSVpvn_flags(aptr, len, SVs_TEMP));
            }
            break;
            }
            break;
-#ifdef HAS_QUAD
+#if defined(HAS_QUAD) && IVSIZE >= 8
        case 'q':
            while (len-- > 0) {
                Quad_t aquad;
        case 'q':
            while (len-- > 0) {
                Quad_t aquad;
-               SHIFT_VAR(utf8, s, strend, aquad, datumtype);
-               DO_BO_UNPACK(aquad, 64);
+                SHIFT_VAR(utf8, s, strend, aquad, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                    PUSHs(sv_2mortal(aquad >= IV_MIN && aquad <= IV_MAX ?
-                                    newSViv((IV)aquad) : newSVnv((NV)aquad)));
+                    mPUSHs(newSViv((IV)aquad));
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aquad;
                else
                else if (checksum > bits_in_uv)
                    cdouble += (NV)aquad;
                else
@@ -1939,158 +1656,133 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
        case 'Q':
            while (len-- > 0) {
                Uquad_t auquad;
        case 'Q':
            while (len-- > 0) {
                Uquad_t auquad;
-               SHIFT_VAR(utf8, s, strend, auquad, datumtype);
-               DO_BO_UNPACK(auquad, 64);
+                SHIFT_VAR(utf8, s, strend, auquad, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(auquad <= UV_MAX ?
-                                    newSVuv((UV)auquad):newSVnv((NV)auquad)));
+                   mPUSHs(newSVuv((UV)auquad));
                else if (checksum > bits_in_uv)
                    cdouble += (NV)auquad;
                else
                    cuv += auquad;
            }
            break;
                else if (checksum > bits_in_uv)
                    cdouble += (NV)auquad;
                else
                    cuv += auquad;
            }
            break;
-#endif /* HAS_QUAD */
+#endif
        /* float and double added gnb@melba.bby.oz.au 22/11/89 */
        case 'f':
            while (len-- > 0) {
                float afloat;
        /* float and double added gnb@melba.bby.oz.au 22/11/89 */
        case 'f':
            while (len-- > 0) {
                float afloat;
-               SHIFT_VAR(utf8, s, strend, afloat, datumtype);
-               DO_BO_UNPACK_N(afloat, float);
+                SHIFT_VAR(utf8, s, strend, afloat, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVnv((NV)afloat)));
+                   mPUSHn(afloat);
                else
                    cdouble += afloat;
                else
                    cdouble += afloat;
-               }
+           }
            break;
        case 'd':
            while (len-- > 0) {
                double adouble;
            break;
        case 'd':
            while (len-- > 0) {
                double adouble;
-               SHIFT_VAR(utf8, s, strend, adouble, datumtype);
-               DO_BO_UNPACK_N(adouble, double);
+                SHIFT_VAR(utf8, s, strend, adouble, datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVnv((NV)adouble)));
+                   mPUSHn(adouble);
                else
                    cdouble += adouble;
                else
                    cdouble += adouble;
-               }
+           }
            break;
        case 'F':
            while (len-- > 0) {
            break;
        case 'F':
            while (len-- > 0) {
-               NV anv;
-               SHIFT_VAR(utf8, s, strend, anv, datumtype);
-               DO_BO_UNPACK_N(anv, NV);
+               NV_bytes anv;
+                SHIFT_BYTES(utf8, s, strend, anv.bytes, sizeof(anv.bytes),
+                            datumtype, needs_swap);
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVnv(anv)));
+                   mPUSHn(anv.nv);
                else
                else
-                   cdouble += anv;
-               }
+                   cdouble += anv.nv;
+           }
            break;
 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
        case 'D':
            while (len-- > 0) {
            break;
 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
        case 'D':
            while (len-- > 0) {
-               long double aldouble;
-               SHIFT_VAR(utf8, s, strend, aldouble, datumtype);
-               DO_BO_UNPACK_N(aldouble, long double);
+               ld_bytes aldouble;
+                SHIFT_BYTES(utf8, s, strend, aldouble.bytes,
+                            sizeof(aldouble.bytes), datumtype, needs_swap);
+                /* The most common long double format, the x86 80-bit
+                 * extended precision, has either 2 or 6 unused bytes,
+                 * which may contain garbage, which may contain
+                 * unintentional data.  While we do zero the bytes of
+                 * the long double data in pack(), here in unpack() we
+                 * don't, because it's really hard to envision that
+                 * reading the long double off aldouble would be
+                 * affected by the unused bytes.
+                 *
+                 * Note that trying to unpack 'long doubles' of 'long
+                 * doubles' packed in another system is in the general
+                 * case doomed without having more detail. */
                if (!checksum)
                if (!checksum)
-                   PUSHs(sv_2mortal(newSVnv((NV)aldouble)));
+                   mPUSHn(aldouble.ld);
                else
                else
-                   cdouble += aldouble;
+                   cdouble += aldouble.ld;
            }
            break;
 #endif
        case 'u':
            }
            break;
 #endif
        case 'u':
-           /* MKS:
-            * Initialise the decode mapping.  By using a table driven
-             * algorithm, the code will be character-set independent
-             * (and just as fast as doing character arithmetic)
-             */
-            if (PL_uudmap['M'] == 0) {
-                int i;
-
-                for (i = 0; i < sizeof(PL_uuemap); i += 1)
-                    PL_uudmap[(U8)PL_uuemap[i]] = i;
-                /*
-                 * Because ' ' and '`' map to the same value,
-                 * we need to decode them both the same.
-                 */
-                PL_uudmap[' '] = 0;
+           if (!checksum) {
+                const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
+               sv = sv_2mortal(newSV(l));
+               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;
             }
             }
-           {
-               STRLEN l = (STRLEN) (strend - s) * 3 / 4;
-               sv = sv_2mortal(NEWSV(42, l));
-               if (l) SvPOK_on(sv);
-           }
-           if (utf8) {
-               while (next_uni_uu(aTHX_ &s, strend, &len)) {
-                   I32 a, b, c, d;
-                   char hunk[4];
-
-                   hunk[3] = '\0';
-                   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);
-                       sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
-                       len -= 3;
-                   }
-                   if (s < strend) {
-                       if (*s == '\n') s++;
-                       else {
-                           /* possible checksum byte */
-                           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[4];
-
-               hunk[3] = '\0';
-               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);
-                   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;
-           }
-           }
-           XPUSHs(sv);
+           if (!checksum)
+               XPUSHs(sv);
            break;
            break;
-       }
+       } /* End of switch */
 
        if (checksum) {
 
        if (checksum) {
-           if (strchr("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
+           if (memCHRs("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
              (checksum > bits_in_uv &&
              (checksum > bits_in_uv &&
-              strchr("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
+              memCHRs("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
                NV trouble, anv;
 
                 anv = (NV) (1 << (checksum & 15));
                NV trouble, anv;
 
                 anv = (NV) (1 << (checksum & 15));
@@ -2100,7 +1792,18 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                }
                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 {
@@ -2110,13 +1813,13 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char
                }
                sv = newSVuv(cuv);
            }
                }
                sv = newSVuv(cuv);
            }
-           XPUSHs(sv_2mortal(sv));
+           mXPUSHs(sv);
            checksum = 0;
        }
            checksum = 0;
        }
-    
+
         if (symptr->flags & FLAG_SLASH){
             if (SP - PL_stack_base - start_sp_offset <= 0)
         if (symptr->flags & FLAG_SLASH){
             if (SP - PL_stack_base - start_sp_offset <= 0)
-                Perl_croak(aTHX_ "'/' must follow a numeric type in unpack");
+               break;
             if( next_symbol(symptr) ){
               if( symptr->howlen == e_number )
                Perl_croak(aTHX_ "Count after length/code in unpack" );
             if( next_symbol(symptr) ){
               if( symptr->howlen == e_number )
                Perl_croak(aTHX_ "Count after length/code in unpack" );
@@ -2148,14 +1851,14 @@ PP(pp_unpack)
 {
     dSP;
     dPOPPOPssrl;
 {
     dSP;
     dPOPPOPssrl;
-    I32 gimme = GIMME_V;
+    U8 gimme = GIMME_V;
     STRLEN llen;
     STRLEN rlen;
     STRLEN llen;
     STRLEN rlen;
-    char *pat = SvPV(left,  llen);
-    char *s   = SvPV(right, rlen);
-    char *strend = s + rlen;
-    char *patend = pat + llen;
-    I32 cnt;
+    const char *pat = SvPV_const(left,  llen);
+    const char *s   = SvPV_const(right, rlen);
+    const char *strend = s + rlen;
+    const char *patend = pat + llen;
+    SSize_t cnt;
 
     PUTBACK;
     cnt = unpackstring(pat, patend, s, strend,
 
     PUTBACK;
     cnt = unpackstring(pat, patend, s, strend,
@@ -2169,7 +1872,7 @@ PP(pp_unpack)
 }
 
 STATIC U8 *
 }
 
 STATIC U8 *
-doencodes(U8 *h, 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) {
@@ -2181,7 +1884,7 @@ doencodes(U8 *h, char *s, I32 len)
        len -= 3;
     }
     if (len > 0) {
        len -= 3;
     }
     if (len > 0) {
-       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))];
@@ -2192,14 +1895,15 @@ doencodes(U8 *h, char *s, I32 len)
 }
 
 STATIC SV *
 }
 
 STATIC SV *
-S_is_an_int(pTHX_ char *s, STRLEN l)
+S_is_an_int(pTHX_ const char *s, STRLEN l)
 {
 {
-  STRLEN        n_a;
-  SV             *result = newSVpvn(s, l);
-  char           *result_c = SvPV(result, n_a);        /* convenience */
-  char           *out = result_c;
-  bool            skip = 1;
-  bool            ignore = 0;
+  SV *result = newSVpvn(s, l);
+  char *const result_c = SvPV_nolen(result);   /* convenience */
+  char *out = result_c;
+  bool skip = 1;
+  bool ignore = 0;
+
+  PERL_ARGS_ASSERT_IS_AN_INT;
 
   while (*s) {
     switch (*s) {
 
   while (*s) {
     switch (*s) {
@@ -2244,74 +1948,50 @@ S_is_an_int(pTHX_ char *s, STRLEN l)
 STATIC int
 S_div128(pTHX_ SV *pnum, bool *done)
 {
 STATIC int
 S_div128(pTHX_ SV *pnum, bool *done)
 {
-  STRLEN          len;
-  char           *s = SvPV(pnum, len);
-  int             m = 0;
-  int             r = 0;
-  char           *t = s;
-
-  *done = 1;
-  while (*t) {
-    int             i;
-
-    i = m * 10 + (*t - '0');
-    m = i & 0x7F;
-    r = (i >> 7);              /* r < 10 */
-    if (r) {
-      *done = 0;
+    STRLEN len;
+    char * const s = SvPV(pnum, len);
+    char *t = s;
+    int m = 0;
+
+    PERL_ARGS_ASSERT_DIV128;
+
+    *done = 1;
+    while (*t) {
+       const int i = m * 10 + (*t - '0');
+       const int r = (i >> 7); /* r < 10 */
+       m = i & 0x7F;
+       if (r) {
+           *done = 0;
+       }
+       *(t++) = '0' + r;
     }
     }
-    *(t++) = '0' + r;
-  }
-  *(t++) = '\0';
-  SvCUR_set(pnum, (STRLEN) (t - s));
-  return (m);
-}
-
-
-
-/*
-=for apidoc pack_cat
-
-The engine implementing pack() Perl function. Note: parameters next_in_list and
-flags are not used. This call should not be used; use packlist instead.
-
-=cut */
-
-
-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;
-
-    (void)pack_rec( cat, &sym, beglist, endlist );
+    *(t++) = '\0';
+    SvCUR_set(pnum, (STRLEN) (t - s));
+    return (m);
 }
 
 }
 
-
 /*
 =for apidoc packlist
 
 /*
 =for apidoc packlist
 
-The engine implementing pack() Perl function.
-
-=cut */
+The engine implementing C<pack()> Perl function.
 
 
+=cut
+*/
 
 void
 
 void
-Perl_packlist(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist )
+Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist )
 {
 {
-    STRLEN no_len;
-    tempsym_t sym = { 0 };
+    tempsym_t sym;
+
+    PERL_ARGS_ASSERT_PACKLIST;
 
 
-    sym.patptr = pat;
-    sym.patend = patend;
-    sym.flags  = FLAG_PACK;
+    TEMPSYM_INIT(&sym, pat, patend, FLAG_PACK);
 
     /* We're going to do changes through SvPVX(cat). Make sure it's valid.
        Also make sure any UTF8 flag is loaded */
 
     /* We're going to do changes through SvPVX(cat). Make sure it's valid.
        Also make sure any UTF8 flag is loaded */
-    SvPV_force(cat, no_len);
-    if (DO_UTF8(cat)) sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8;
+    SvPV_force_nolen(cat);
+    if (DO_UTF8(cat))
+       sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8;
 
     (void)pack_rec( cat, &sym, beglist, endlist );
 }
 
     (void)pack_rec( cat, &sym, beglist, endlist );
 }
@@ -2321,27 +2001,27 @@ STATIC void
 marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
     STRLEN len;
     tempsym_t *group;
 marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
     STRLEN len;
     tempsym_t *group;
-    char *from_ptr, *to_start, *to_ptr, **marks, **m, *from_start, *from_end;
+    const char *from_ptr, *from_start, *from_end, **marks, **m;
+    char *to_start, *to_ptr;
 
     if (SvUTF8(sv)) return;
 
 
     if (SvUTF8(sv)) return;
 
-    from_start = SvPVX(sv);
+    from_start = SvPVX_const(sv);
     from_end = from_start + SvCUR(sv);
     for (from_ptr = from_start; from_ptr < from_end; from_ptr++)
     from_end = from_start + SvCUR(sv);
     for (from_ptr = from_start; from_ptr < from_end; from_ptr++)
-       if (!NATIVE_IS_INVARIANT(*from_ptr)) break;
+       if (!NATIVE_BYTE_IS_INVARIANT(*from_ptr)) break;
     if (from_ptr == from_end) {
        /* Simple case: no character needs to be changed */
        SvUTF8_on(sv);
        return;
     }
 
     if (from_ptr == from_end) {
        /* Simple case: no character needs to be changed */
        SvUTF8_on(sv);
        return;
     }
 
-    /* We assume a char translates to at most 2 UTF-8 bytes */
-    len = (from_end-from_ptr)*2+(from_ptr-from_start)+1;
-    New('U', to_start, len, char);
+    len = (from_end-from_ptr)*UTF8_EXPAND+(from_ptr-from_start)+1;
+    Newx(to_start, len, char);
     Copy(from_start, to_start, from_ptr-from_start, char);
     to_ptr = to_start + (from_ptr-from_start);
 
     Copy(from_start, to_start, from_ptr-from_start, char);
     to_ptr = to_start + (from_ptr-from_start);
 
-    New('U', marks, sym_ptr->level+2, char *);
+    Newx(marks, sym_ptr->level+2, const char *);
     for (group=sym_ptr; group; group = group->previous)
        marks[group->level] = from_start + group->strbeg;
     marks[sym_ptr->level+1] = from_end+1;
     for (group=sym_ptr; group; group = group->previous)
        marks[group->level] = from_start + group->strbeg;
     marks[sym_ptr->level+1] = from_end+1;
@@ -2350,7 +2030,7 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
 
     for (;from_ptr < from_end; from_ptr++) {
        while (*m == from_ptr) *m++ = to_ptr;
 
     for (;from_ptr < from_end; from_ptr++) {
        while (*m == from_ptr) *m++ = to_ptr;
-       to_ptr = uvchr_to_utf8(to_ptr, *(U8 *) from_ptr);
+       to_ptr = (char *) uvchr_to_utf8((U8 *) to_ptr, *(U8 *) from_ptr);
     }
     *to_ptr = 0;
 
     }
     *to_ptr = 0;
 
@@ -2358,7 +2038,8 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
     if (m != marks + sym_ptr->level+1) {
        Safefree(marks);
        Safefree(to_start);
     if (m != marks + sym_ptr->level+1) {
        Safefree(marks);
        Safefree(to_start);
-       Perl_croak(aTHX_ "Assertion: marks beyond string end");
+       Perl_croak(aTHX_ "panic: marks beyond string end, m=%p, marks=%p, "
+                  "level=%d", m, marks, sym_ptr->level);
     }
     for (group=sym_ptr; group; group = group->previous)
        group->strbeg = marks[group->level] - to_start;
     }
     for (group=sym_ptr; group; group = group->previous)
        group->strbeg = marks[group->level] - to_start;
@@ -2366,7 +2047,7 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
 
     if (SvOOK(sv)) {
        if (SvIVX(sv)) {
 
     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);
        }
            from_start -= SvIVX(sv);
            SvIV_set(sv, 0);
        }
@@ -2374,9 +2055,9 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
     }
     if (SvLEN(sv) != 0)
        Safefree(from_start);
     }
     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);
 }
 
     SvUTF8_on(sv);
 }
 
@@ -2385,23 +2066,52 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
    Only grows the string if there is an actual lack of space
 */
 STATIC char *
    Only grows the string if there is an actual lack of space
 */
 STATIC char *
-sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
-    STRLEN cur = SvCUR(sv);
-    STRLEN len = SvLEN(sv);
+S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
+    const STRLEN cur = SvCUR(sv);
+    const STRLEN len = SvLEN(sv);
     STRLEN extend;
     STRLEN extend;
+
+    PERL_ARGS_ASSERT_SV_EXP_GROW;
+
     if (len - cur > needed) return SvPVX(sv);
     extend = needed > len ? needed : len;
     return SvGROW(sv, len+extend+1);
 }
 
     if (len - cur > needed) return SvPVX(sv);
     extend = needed > len ? needed : len;
     return SvGROW(sv, len+extend+1);
 }
 
+static SV *
+S_sv_check_infnan(pTHX_ SV *sv, I32 datumtype)
+{
+    SvGETMAGIC(sv);
+    if (UNLIKELY(SvAMAGIC(sv)))
+       sv = sv_2num(sv);
+    if (UNLIKELY(isinfnansv(sv))) {
+       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);
+       else
+           Perl_croak(aTHX_ "Cannot pack %" NVgf " with '%c'", nv, (int) c);
+    }
+    return sv;
+}
+
+#define SvIV_no_inf(sv,d) \
+       ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvIV_nomg(sv))
+#define SvUV_no_inf(sv,d) \
+       ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvUV_nomg(sv))
+
 STATIC
 SV **
 S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 {
     tempsym_t lookahead;
 STATIC
 SV **
 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 found = next_symbol(symptr);
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
+    bool warn_utf8 = ckWARN(WARN_UTF8);
+    char* from;
+
+    PERL_ARGS_ASSERT_PACK_REC;
 
     if (symptr->level == 0 && found && symptr->code == 'U') {
        marked_upgrade(aTHX_ cat, symptr);
 
     if (symptr->level == 0 && found && symptr->code == 'U') {
        marked_upgrade(aTHX_ cat, symptr);
@@ -2413,18 +2123,20 @@ 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;
-       SV *lengthcode = Nullsv;
+       SSize_t len;
+       SV *lengthcode = NULL;
         I32 datumtype = symptr->code;
         howlen_t howlen = symptr->howlen;
        char *start = SvPVX(cat);
        char *cur   = start + SvCUR(cat);
         I32 datumtype = symptr->code;
         howlen_t howlen = symptr->howlen;
        char *start = SvPVX(cat);
        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) {
 
         switch (howlen) {
-        case e_star:
-           len = strchr("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
+         case e_star:
+           len = memCHRs("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
                0 : items;
            break;
          default:
                0 : items;
            break;
          default:
@@ -2434,71 +2146,102 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
         }
 
        if (len) {
         }
 
        if (len) {
-           struct packsize_t *pack_props =
-               &packsize[(symptr->code & TYPE_IS_SHRIEKING) ?
-                         PACK_SIZE_SHRIEKING : PACK_SIZE_NORMAL];
-           const int rawtype = TYPE_NO_MODIFIERS(datumtype);
-           int offset = rawtype - pack_props->first;
-
-           if (offset >= 0 && offset < pack_props->size) {
-               /* Data about this template letter  */
-               unsigned char data = pack_props->array[offset];
-
-               if (data && !(data & PACK_SIZE_UNPREDICTABLE)) {
-                   /* We can process this letter.  */
-                   STRLEN size = data & PACK_SIZE_MASK;
-                   GROWING(utf8, cat, start, cur, (STRLEN) len * size);
-               }
-           }
+           packprops_t props = packprops[TYPE_NO_ENDIANNESS(datumtype)];
 
 
+           if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
+               /* We can process this letter. */
+               STRLEN size = props & PACK_SIZE_MASK;
+               GROWING2(utf8, cat, start, cur, size, (STRLEN)len);
+           }
         }
 
         /* Look ahead for next symbol. Do we have code/code? */
         lookahead = *symptr;
         found = next_symbol(&lookahead);
         }
 
         /* Look ahead for next symbol. Do we have code/code? */
         lookahead = *symptr;
         found = next_symbol(&lookahead);
-       if ( symptr->flags & FLAG_SLASH ) {
+       if (symptr->flags & FLAG_SLASH) {
+           IV count;
            if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack");
            if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack");
-               if ( 0 == strchr( "aAZ", lookahead.code ) ||
-                     e_star != lookahead.howlen )
-                   Perl_croak(aTHX_ "'/' must be followed by 'a*', 'A*' or 'Z*' in pack");
-           lengthcode =
-               sv_2mortal(newSViv((items > 0 ? DO_UTF8(*beglist) ? sv_len_utf8(*beglist) : sv_len(*beglist) : 0) + (lookahead.code == 'Z' ? 1 : 0)));
+           if (memCHRs("aAZ", lookahead.code)) {
+               if (lookahead.howlen == e_number) count = lookahead.length;
+               else {
+                   if (items > 0) {
+                       count = sv_len_utf8(*beglist);
+                   }
+                   else count = 0;
+                   if (lookahead.code == 'Z') count++;
+               }
+           } else {
+               if (lookahead.howlen == e_number && lookahead.length < items)
+                   count = lookahead.length;
+               else count = items;
+           }
+           lookahead.howlen = e_number;
+           lookahead.length = count;
+           lengthcode = sv_2mortal(newSViv(count));
        }
 
        }
 
-       /* Code inside the switch must take care to properly update 
-          cat (CUR length and '\0' termination) if it updated *cur and 
+        needs_swap = NEEDS_SWAP(datumtype);
+
+       /* Code inside the switch must take care to properly update
+          cat (CUR length and '\0' termination) if it updated *cur and
           doesn't simply leave using break */
           doesn't simply leave using break */
-       switch(TYPE_NO_ENDIANNESS(datumtype)) {
+       switch (TYPE_NO_ENDIANNESS(datumtype)) {
        default:
            Perl_croak(aTHX_ "Invalid type '%c' in pack",
                       (int) TYPE_NO_MODIFIERS(datumtype));
        case '%':
            Perl_croak(aTHX_ "'%%' may not be used in pack");
        default:
            Perl_croak(aTHX_ "Invalid type '%c' in pack",
                       (int) TYPE_NO_MODIFIERS(datumtype));
        case '%':
            Perl_croak(aTHX_ "'%%' may not be used in pack");
+
+       case '.' | TYPE_IS_SHRIEKING:
+       case '.':
+           if (howlen == e_star) from = start;
+           else if (len == 0) from = cur;
+           else {
+               tempsym_t *group = symptr;
+
+               while (--len && group) group = group->previous;
+               from = group ? start + group->strbeg : start;
+           }
+           fromstr = NEXTFROM;
+           len = SvIV_no_inf(fromstr, datumtype);
+           goto resize;
+       case '@' | TYPE_IS_SHRIEKING:
        case '@':
        case '@':
-           if (utf8) {
-               char *s = start + symptr->strbeg;
-               while (len > 0 && s < cur) {
-                   s += UTF8SKIP(s);
-                   len--;
+           from = start + symptr->strbeg;
+         resize:
+           if (utf8  && !(datumtype & TYPE_IS_SHRIEKING))
+               if (len >= 0) {
+                   while (len && from < cur) {
+                       from += UTF8SKIP(from);
+                       len--;
+                   }
+                   if (from > cur)
+                       Perl_croak(aTHX_ "Malformed UTF-8 string in pack");
+                   if (len) {
+                       /* Here we know from == cur */
+                     grow:
+                       GROWING(0, cat, start, cur, len);
+                       Zero(cur, len, char);
+                       cur += len;
+                   } else if (from < cur) {
+                       len = cur - from;
+                       goto shrink;
+                   } else goto no_change;
+               } else {
+                   cur = from;
+                   len = -len;
+                   goto utf8_shrink;
                }
                }
-               if (s > cur)
-                   Perl_croak(aTHX_ "Malformed UTF-8 string in pack");
-               if (len > 0) {
-                 grow:
-                   GROWING(0, cat, start, cur, len);
-                   Zero(cur, len, char);
-                   cur += len;
-               } else if (s < cur) cur = s;
-               else goto no_change;
-           } else {
-               len -= cur - (start+symptr->strbeg);
+           else {
+               len -= cur - from;
                if (len > 0) goto grow;
                if (len > 0) goto grow;
-           len = -len;
-               if (len > 0) goto shrink;
-               else goto no_change;
+               if (len == 0) goto no_change;
+               len = -len;
+               goto shrink;
            }
            break;
            }
            break;
-         case '(': {
+
+       case '(': {
             tempsym_t savsym = *symptr;
            U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags);
            symptr->flags |= group_modifiers;
             tempsym_t savsym = *symptr;
            U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags);
            symptr->flags |= group_modifiers;
@@ -2519,6 +2262,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (savsym.howlen == e_star && beglist == endlist)
                    break;              /* No way to continue */
            }
                if (savsym.howlen == e_star && beglist == endlist)
                    break;              /* No way to continue */
            }
+           items = endlist - beglist;
            lookahead.flags  = symptr->flags & ~group_modifiers;
            goto no_change;
        }
            lookahead.flags  = symptr->flags & ~group_modifiers;
            goto no_change;
        }
@@ -2527,7 +2271,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);
@@ -2542,56 +2286,60 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                break;
            }
            len = (cur-start) % len;
                break;
            }
            len = (cur-start) % len;
-           /* FALL THROUGH */
+           /* FALLTHROUGH */
        case 'X':
            if (utf8) {
                if (len < 1) goto no_change;
        case 'X':
            if (utf8) {
                if (len < 1) goto no_change;
+             utf8_shrink:
                while (len > 0) {
                    if (cur <= start)
                while (len > 0) {
                    if (cur <= start)
-                       Perl_croak(aTHX_ "'X' outside of string in pack");
+                       Perl_croak(aTHX_ "'%c' outside of string in pack",
+                                  (int) TYPE_NO_MODIFIERS(datumtype));
                    while (--cur, UTF8_IS_CONTINUATION(*cur)) {
                        if (cur <= start)
                    while (--cur, UTF8_IS_CONTINUATION(*cur)) {
                        if (cur <= start)
-                           Perl_croak(aTHX_ "'X' outside of string in pack");
+                           Perl_croak(aTHX_ "'%c' outside of string in pack",
+                                      (int) TYPE_NO_MODIFIERS(datumtype));
                    }
                    len--;
                }
            } else {
                    }
                    len--;
                }
            } else {
-         shrink:
+             shrink:
                if (cur - start < len)
                if (cur - start < len)
-               Perl_croak(aTHX_ "'X' outside of string in pack");
+                   Perl_croak(aTHX_ "'%c' outside of string in pack",
+                              (int) TYPE_NO_MODIFIERS(datumtype));
                cur -= len;
            }
            if (cur < start+symptr->strbeg) {
                /* Make sure group starts don't point into the void */
                tempsym_t *group;
                cur -= len;
            }
            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;
                lookahead.strbeg = length;
            }
            break;
                for (group = symptr;
                     group && length < group->strbeg;
                     group = group->previous) group->strbeg = length;
                lookahead.strbeg = length;
            }
            break;
-         case 'x' | TYPE_IS_SHRIEKING: {
-             I32 ai32;
+       case 'x' | TYPE_IS_SHRIEKING: {
+           SSize_t ai32;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
-             if (utf8) ai32 = utf8_length(start, cur) % len;
-             else      ai32 = (cur - start) % len;
-             if (ai32 == 0) goto no_change;
-             len -= ai32;
-         }
-           /* FALL THROUGH */
+           if (utf8) ai32 = utf8_length((U8 *) start, (U8 *) cur) % len;
+           else      ai32 = (cur - start) % len;
+           if (ai32 == 0) goto no_change;
+           len -= ai32;
+       }
+       /* FALLTHROUGH */
        case 'x':
            goto grow;
        case 'A':
        case 'Z':
        case 'a': {
        case 'x':
            goto grow;
        case 'A':
        case 'Z':
        case 'a': {
-           char *aptr;
+           const char *aptr;
 
            fromstr = NEXTFROM;
 
            fromstr = NEXTFROM;
-           aptr = SvPV(fromstr, fromlen);
+           aptr = SvPV_const(fromstr, fromlen);
            if (DO_UTF8(fromstr)) {
            if (DO_UTF8(fromstr)) {
-               char *end, *s;
+                const char *end, *s;
 
                if (!utf8 && !SvUTF8(cat)) {
                    marked_upgrade(aTHX_ cat, symptr);
 
                if (!utf8 && !SvUTF8(cat)) {
                    marked_upgrade(aTHX_ cat, symptr);
@@ -2601,37 +2349,39 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    start = SvPVX(cat);
                    cur = start + SvCUR(cat);
                }
                    start = SvPVX(cat);
                    cur = start + SvCUR(cat);
                }
-           if (howlen == e_star) {   
+               if (howlen == e_star) {
                    if (utf8) goto string_copy;
                    len = fromlen+1;
                }
                s = aptr;
                end = aptr + fromlen;
                fromlen = datumtype == 'Z' ? len-1 : len;
                    if (utf8) goto string_copy;
                    len = fromlen+1;
                }
                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--;
                }
                if (s > end)
                    Perl_croak(aTHX_ "Malformed UTF-8 string in pack");
                if (utf8) {
                    s += UTF8SKIP(s);
                    fromlen--;
                }
                if (s > end)
                    Perl_croak(aTHX_ "Malformed UTF-8 string in pack");
                if (utf8) {
-               len = fromlen;
+                   len = fromlen;
                    if (datumtype == 'Z') len++;
                    fromlen = s-aptr;
                    len += fromlen;
                    if (datumtype == 'Z') len++;
                    fromlen = s-aptr;
                    len += fromlen;
-                     
+
                    goto string_copy;
                    goto string_copy;
-           }
+               }
                fromlen = len - fromlen;
                if (datumtype == 'Z') fromlen--;
                if (howlen == e_star) {
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                fromlen = len - fromlen;
                if (datumtype == 'Z') fromlen--;
                if (howlen == e_star) {
                    len = fromlen;
                    if (datumtype == 'Z') len++;
-           }
+               }
                GROWING(0, cat, start, cur, 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))
                                  datumtype | TYPE_IS_PACK))
-                   Perl_croak(aTHX_ "Perl bug: predicted utf8 length not available");
+                   Perl_croak(aTHX_ "panic: predicted utf8 length not available, "
+                              "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) {
@@ -2639,26 +2389,27 @@ 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--;
                }
-               /* assumes a byte expands to at most 2 bytes on upgrade:
-                  expected_length <= from_len*2 + (len-from_len) */
-               GROWING(0, cat, start, cur, fromlen+len);
+               /* assumes a byte expands to at most UTF8_EXPAND bytes on
+                  upgrade, so:
+                  expected_length <= from_len*UTF8_EXPAND + (len-from_len) */
+               GROWING(0, cat, start, cur, fromlen*(UTF8_EXPAND-1)+len);
                len -= fromlen;
                while (fromlen > 0) {
                len -= fromlen;
                while (fromlen > 0) {
-                   cur = uvchr_to_utf8(cur, * (U8 *) aptr);
+                   cur = (char *) uvchr_to_utf8((U8 *) cur, * (U8 *) aptr);
                    aptr++;
                    fromlen--;
                    aptr++;
                    fromlen--;
-                   }
+               }
            } else {
              string_copy:
                if (howlen == e_star) {
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                }
            } else {
              string_copy:
                if (howlen == e_star) {
                    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--;
                }
@@ -2669,22 +2420,23 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            }
            memset(cur, datumtype == 'A' ? ' ' : '\0', len);
            cur += len;
            }
            memset(cur, datumtype == 'A' ? ' ' : '\0', len);
            cur += len;
+           SvTAINT(cat);
            break;
        }
        case 'B':
        case 'b': {
            break;
        }
        case 'B':
        case 'b': {
-           char *str, *end;
-           I32 l, field_len;
+           const char *str, *end;
+           SSize_t l, field_len;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
 
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
 
-               fromstr = NEXTFROM;
-               str = SvPV(fromstr, fromlen);
+           fromstr = NEXTFROM;
+           str = SvPV_const(fromstr, fromlen);
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
-               utf8_flags  = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+               utf8_flags  = warn_utf8 ? 0 : UTF8_ALLOW_ANY;
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
@@ -2692,18 +2444,18 @@ 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')
                while (l++ < len) {
                    if (utf8_source) {
            bits = 0;
            l = 0;
            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;
                    if (l & 7) bits <<= 1;
                        NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
                        bits |= val & 1;
                    } else bits |= *str++ & 1;
                    if (l & 7) bits <<= 1;
-                       else {
+                   else {
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
                    }
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
                    }
@@ -2712,22 +2464,22 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                /* datumtype == 'b' */
                while (l++ < len) {
                    if (utf8_source) {
                /* 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)
                        bits |= 0x80;
                    if (l & 7) bits >>= 1;
                        NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
                        if (val & 1) bits |= 0x80;
                    } else if (*str++ & 1)
                        bits |= 0x80;
                    if (l & 7) bits >>= 1;
-               else {
+                   else {
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
                    }
                }
            l--;
            if (l & 7) {
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
                    }
                }
            l--;
            if (l & 7) {
-                   if (datumtype == 'B')
+               if (datumtype == 'B')
                    bits <<= 7 - (l & 7);
                    bits <<= 7 - (l & 7);
-                   else
+               else
                    bits >>= 7 - (l & 7);
                PUSH_BYTE(utf8, cur, bits);
                l += 7;
                    bits >>= 7 - (l & 7);
                PUSH_BYTE(utf8, cur, bits);
                l += 7;
@@ -2742,18 +2494,18 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        }
        case 'H':
        case 'h': {
        }
        case 'H':
        case 'h': {
-           char *str, *end;
-           I32 l, field_len;
+           const char *str, *end;
+           SSize_t l, field_len;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
 
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
 
-               fromstr = NEXTFROM;
-               str = SvPV(fromstr, fromlen);
+           fromstr = NEXTFROM;
+           str = SvPV_const(fromstr, fromlen);
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
-               utf8_flags  = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+               utf8_flags  = warn_utf8 ? 0 : UTF8_ALLOW_ANY;
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
@@ -2761,13 +2513,13 @@ 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')
                while (l++ < len) {
                    if (utf8_source) {
            bits = 0;
            l = 0;
            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;
                        NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
                        if (val < 256 && isALPHA(val))
                            bits |= (val + 9) & 0xf;
@@ -2778,7 +2530,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    else
                        bits |= *str++ & 0xf;
                    if (l & 1) bits <<= 4;
                    else
                        bits |= *str++ & 0xf;
                    if (l & 1) bits <<= 4;
-                       else {
+                   else {
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
                    }
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
                    }
@@ -2786,7 +2538,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            else
                while (l++ < len) {
                    if (utf8_source) {
            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;
                        NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
                        if (val < 256 && isALPHA(val))
                            bits |= ((val + 9) & 0xf) << 4;
@@ -2797,11 +2549,11 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    else
                        bits |= (*str++ & 0xf) << 4;
                    if (l & 1) bits >>= 4;
                    else
                        bits |= (*str++ & 0xf) << 4;
                    if (l & 1) bits >>= 4;
-               else {
+                   else {
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
                        PUSH_BYTE(utf8, cur, bits);
                        bits = 0;
-                       }
                    }
                    }
+               }
            l--;
            if (l & 1) {
                PUSH_BYTE(utf8, cur, bits);
            l--;
            if (l & 1) {
                PUSH_BYTE(utf8, cur, bits);
@@ -2814,17 +2566,16 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            Zero(cur, field_len, char);
            cur += field_len;
            break;
            Zero(cur, field_len, char);
            cur += field_len;
            break;
-               }
-         case 'c':
+       }
+       case 'c':
            while (len-- > 0) {
                IV aiv;
                fromstr = NEXTFROM;
            while (len-- > 0) {
                IV aiv;
                fromstr = NEXTFROM;
-               aiv = SvIV(fromstr);
-               if ((-128 > aiv || aiv > 127) &&
-                   ckWARN(WARN_PACK))
-                   Perl_warner(aTHX_ packWARN(WARN_PACK),
-                               "Character in 'c' format wrapped in pack");
-               PUSH_BYTE(utf8, cur, aiv & 0xff);
+                aiv = SvIV_no_inf(fromstr, datumtype);
+               if ((-128 > aiv || aiv > 127))
+                   Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                  "Character in 'c' format wrapped in pack");
+               PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff));
            }
            break;
        case 'C':
            }
            break;
        case 'C':
@@ -2832,116 +2583,110 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0;
                break;
            }
                utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0;
                break;
            }
-           GROWING(0, cat, start, cur, len);
            while (len-- > 0) {
                IV aiv;
                fromstr = NEXTFROM;
            while (len-- > 0) {
                IV aiv;
                fromstr = NEXTFROM;
-               aiv = SvIV(fromstr);
-               if ((0 > aiv || aiv > 0xff) &&
-                       ckWARN(WARN_PACK))
-                       Perl_warner(aTHX_ packWARN(WARN_PACK),
-                                   "Character in 'C' format wrapped in pack");
-               *cur++ = aiv & 0xff;
-           }
-                   break;
-         case 'W': {
-             char *end;
-             U8 in_bytes = IN_BYTES;
-
-             end = start+SvLEN(cat)-1;
-             if (utf8) end -= UTF8_MAXLEN-1;
-             while (len-- > 0) {
-                 UV auv;
-                 fromstr = NEXTFROM;
-                 auv = SvUV(fromstr);
-                 if (in_bytes) auv = auv % 0x100;
-                 if (utf8) {
-                   W_utf8:
-                     if (cur > end) {
-                         *cur = '\0';
-                         SvCUR(cat) = cur - start;
-                         
-                         GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
-                         end = start+SvLEN(cat)-UTF8_MAXLEN;
-                     }
-                     cur = uvuni_to_utf8_flags(cur, NATIVE_TO_UNI(auv),
-                                               ckWARN(WARN_UTF8) ?
-                                               0 : UNICODE_ALLOW_ANY);
-                 } else {
-                     if (auv >= 0x100) {
-                         if (!SvUTF8(cat)) {
-                             *cur = '\0';
-                             SvCUR(cat) = cur - start;
-                             marked_upgrade(aTHX_ cat, symptr);
-                             lookahead.flags |= FLAG_DO_UTF8;
-                             lookahead.strbeg = symptr->strbeg;
-                             utf8 = 1;
-                             start = SvPVX(cat);
-                             cur = start + SvCUR(cat);
-                             end = start+SvLEN(cat)-UTF8_MAXLEN;
-                             goto W_utf8;
-                         }
-                         if (ckWARN(WARN_PACK))
-                       Perl_warner(aTHX_ packWARN(WARN_PACK),
-                                         "Character in 'W' format wrapped in pack");
-                         auv &= 0xff;
-                     }
-                     if (cur >= end) {
-                         *cur = '\0';
-                         SvCUR(cat) = cur - start;
-                         GROWING(0, cat, start, cur, len+1);
-                         end = start+SvLEN(cat)-1;
-                     }
-                     *(U8 *) cur++ = auv;
+                aiv = SvIV_no_inf(fromstr, datumtype);
+               if ((0 > aiv || aiv > 0xff))
+                   Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                  "Character in 'C' format wrapped in pack");
+               PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff));
+           }
+           break;
+       case 'W': {
+           char *end;
+           U8 in_bytes = (U8)IN_BYTES;
+
+           end = start+SvLEN(cat)-1;
+           if (utf8) end -= UTF8_MAXLEN-1;
+           while (len-- > 0) {
+               UV auv;
+               fromstr = NEXTFROM;
+               auv = SvUV_no_inf(fromstr, datumtype);
+               if (in_bytes) auv = auv % 0x100;
+               if (utf8) {
+                 W_utf8:
+                   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 = (char *) uvchr_to_utf8_flags((U8 *) cur, auv, 0);
+               } else {
+                   if (auv >= 0x100) {
+                       if (!SvUTF8(cat)) {
+                           *cur = '\0';
+                           SvCUR_set(cat, cur - start);
+                           marked_upgrade(aTHX_ cat, symptr);
+                           lookahead.flags |= FLAG_DO_UTF8;
+                           lookahead.strbeg = symptr->strbeg;
+                           utf8 = 1;
+                           start = SvPVX(cat);
+                           cur = start + SvCUR(cat);
+                           end = start+SvLEN(cat)-UTF8_MAXLEN;
+                           goto W_utf8;
+                       }
+                       Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                      "Character in 'W' format wrapped in pack");
+                       auv &= 0xff;
+                   }
+                   if (cur >= end) {
+                       *cur = '\0';
+                       SvCUR_set(cat, cur - start);
+                       GROWING(0, cat, start, cur, len+1);
+                       end = start+SvLEN(cat)-1;
+                   }
+                   *(U8 *) cur++ = (U8)auv;
                }
            }
            break;
                }
            }
            break;
-         }
-         case 'U': {
-             char *end;
-
-             if (len == 0) {
-                 if (!(symptr->flags & FLAG_DO_UTF8)) {
-                     marked_upgrade(aTHX_ cat, symptr);
-                     lookahead.flags |= FLAG_DO_UTF8;
-                     lookahead.strbeg = symptr->strbeg;
-                 }
-                 utf8 = 0;
-                 goto no_change;
-             }
+       }
+       case 'U': {
+           char *end;
 
 
-             end = start+SvLEN(cat);
-             if (!utf8) end -= UTF8_MAXLEN;
+           if (len == 0) {
+               if (!(symptr->flags & FLAG_DO_UTF8)) {
+                   marked_upgrade(aTHX_ cat, symptr);
+                   lookahead.flags |= FLAG_DO_UTF8;
+                   lookahead.strbeg = symptr->strbeg;
+               }
+               utf8 = 0;
+               goto no_change;
+           }
+
+           end = start+SvLEN(cat);
+           if (!utf8) end -= UTF8_MAXLEN;
            while (len-- > 0) {
            while (len-- > 0) {
-                 UV auv;
+               UV auv;
                fromstr = NEXTFROM;
                fromstr = NEXTFROM;
-                 auv = SvUV(fromstr);
-                 if (utf8) {
-                     char buffer[UTF8_MAXLEN], *endb;
-                     endb = uvuni_to_utf8_flags(buffer, auv,
-                                                    ckWARN(WARN_UTF8) ?
-                                               0 : UNICODE_ALLOW_ANY);
-                     if (cur >= end-(endb-buffer)*2) {
-                         *cur = '\0';
-                         SvCUR(cat) = cur - start;
-                         GROWING(0, cat, start, cur, len+(endb-buffer)*2);
-                         end = start+SvLEN(cat)-UTF8_MAXLEN;
-                     }
-                     bytes_to_uni(aTHX_ buffer, endb-buffer, &cur);
-                 } else {
-                     if (cur >= end) {
-                         *cur = '\0';
-                         SvCUR(cat) = cur - start;
-                         GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
-                         end = start+SvLEN(cat)-UTF8_MAXLEN;
-                     }
-                     cur = uvuni_to_utf8_flags(cur, auv,
-                                                    ckWARN(WARN_UTF8) ?
-                                                0 : UNICODE_ALLOW_ANY);
-                 }
+               auv = SvUV_no_inf(fromstr, datumtype);
+               if (utf8) {
+                   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);
+                       GROWING(0, cat, start, cur,
+                               len+(endb-buffer)*UTF8_EXPAND);
+                       end = start+SvLEN(cat);
+                   }
+                    cur = my_bytes_to_utf8(buffer, endb-buffer, cur, 0);
+               } else {
+                   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 = (char *) uvchr_to_utf8_flags((U8 *) cur,
+                                                       UNI_TO_NATIVE(auv),
+                                                      0);
+               }
            }
            break;
            }
            break;
-         }
+       }
        /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
        case 'f':
            while (len-- > 0) {
        /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
        case 'f':
            while (len-- > 0) {
@@ -2949,34 +2694,29 @@ 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);
-#ifdef __VOS__
-               /* VOS does not automatically map a floating-point overflow
-   during conversion from double to float into infinity, so we
-   do it by hand.  This code should either be generalized for
-   any OS that needs it, or removed if and when VOS implements
-   posix-976 (suggestion to support mapping to infinity).
-   Paul.Green@stratus.com 02-04-02.  */
-               if (anv > FLT_MAX)
-                    afloat = _float_constants[0];   /* single prec. inf. */
-               else if (anv < -FLT_MAX)
-                    afloat = _float_constants[0];   /* single prec. inf. */
-               else afloat = (float) anv;
-#else /* __VOS__ */
-# 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
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
- * on Alpha; fake it if we don't have them.
- */
+                * on Alpha; fake it if we don't have them.
+                */
                if (anv > FLT_MAX)
                if (anv > FLT_MAX)
-                    afloat = FLT_MAX;
+                   afloat = FLT_MAX;
                else if (anv < -FLT_MAX)
                else if (anv < -FLT_MAX)
-                    afloat = -FLT_MAX;
+                   afloat = -FLT_MAX;
                else afloat = (float)anv;
 # else
                else afloat = (float)anv;
 # else
-               afloat = (float)anv;
+#  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);
+#  endif
 # endif
 # endif
-#endif /* __VOS__ */
-               DO_BO_PACK_N(afloat, float);
-               PUSH_VAR(utf8, cur, afloat);
+                PUSH_VAR(utf8, cur, afloat, needs_swap);
            }
            break;
        case 'd':
            }
            break;
        case 'd':
@@ -2985,131 +2725,124 @@ 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);
-#ifdef __VOS__
-               /* VOS does not automatically map a floating-point overflow
-   during conversion from long double to double into infinity,
-   so we do it by hand.  This code should either be generalized
-   for any OS that needs it, or removed if and when VOS
-   implements posix-976 (suggestion to support mapping to
-   infinity).  Paul.Green@stratus.com 02-04-02.  */
-               if (anv > DBL_MAX)
-                    adouble = _double_constants[0];   /* double prec. inf. */
-               else if (anv < -DBL_MAX)
-                    adouble = _double_constants[0];   /* double prec. inf. */
-               else adouble = (double) anv;
-#else /* __VOS__ */
-# 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
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
- * on Alpha; fake it if we don't have them.
- */
+                * on Alpha; fake it if we don't have them.
+                */
                if (anv > DBL_MAX)
                if (anv > DBL_MAX)
-                    adouble = DBL_MAX;
+                   adouble = DBL_MAX;
                else if (anv < -DBL_MAX)
                else if (anv < -DBL_MAX)
-                    adouble = -DBL_MAX;
+                   adouble = -DBL_MAX;
                else adouble = (double)anv;
 # else
                adouble = (double)anv;
 # endif
                else adouble = (double)anv;
 # else
                adouble = (double)anv;
 # endif
-#endif /* __VOS__ */
-               DO_BO_PACK_N(adouble, double);
-               PUSH_VAR(utf8, cur, adouble);
+                PUSH_VAR(utf8, cur, adouble, needs_swap);
            }
            break;
            }
            break;
-         case 'F': {
-             NV anv;
+       case 'F': {
+           NV_bytes anv;
            Zero(&anv, 1, NV); /* can be long double with unused bits */
            while (len-- > 0) {
                fromstr = NEXTFROM;
            Zero(&anv, 1, NV); /* can be long double with unused bits */
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               anv = SvNV(fromstr);
-               DO_BO_PACK_N(anv, NV);
-                 PUSH_VAR(utf8, cur, anv);
+#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
+                PUSH_BYTES(utf8, cur, anv.bytes, sizeof(anv.bytes), needs_swap);
            }
            break;
            }
            break;
-         }
+       }
 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
-         case 'D': {
-             long double aldouble;
+       case 'D': {
+           ld_bytes aldouble;
            /* long doubles can have unused bits, which may be nonzero */
            Zero(&aldouble, 1, long double);
            while (len-- > 0) {
                fromstr = NEXTFROM;
            /* long doubles can have unused bits, which may be nonzero */
            Zero(&aldouble, 1, long double);
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               aldouble = (long double)SvNV(fromstr);
-               DO_BO_PACK_N(aldouble, long double);
-                 PUSH_VAR(utf8, cur, aldouble);
+#  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
+                PUSH_BYTES(utf8, cur, aldouble.bytes, sizeof(aldouble.bytes),
+                           needs_swap);
            }
            break;
            }
            break;
-         }
+       }
 #endif
 #endif
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
        case 'n' | TYPE_IS_SHRIEKING:
        case 'n' | TYPE_IS_SHRIEKING:
-#endif
        case 'n':
            while (len-- > 0) {
                I16 ai16;
                fromstr = NEXTFROM;
        case 'n':
            while (len-- > 0) {
                I16 ai16;
                fromstr = NEXTFROM;
-               ai16 = (I16)SvIV(fromstr);
-#ifdef HAS_HTONS
+               ai16 = (I16)SvIV_no_inf(fromstr, datumtype);
                ai16 = PerlSock_htons(ai16);
                ai16 = PerlSock_htons(ai16);
-#endif
-               PUSH16(utf8, cur, &ai16);
+                PUSH16(utf8, cur, &ai16, FALSE);
            }
            break;
            }
            break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
        case 'v' | TYPE_IS_SHRIEKING:
        case 'v' | TYPE_IS_SHRIEKING:
-#endif
        case 'v':
            while (len-- > 0) {
                I16 ai16;
                fromstr = NEXTFROM;
        case 'v':
            while (len-- > 0) {
                I16 ai16;
                fromstr = NEXTFROM;
-               ai16 = (I16)SvIV(fromstr);
-#ifdef HAS_HTOVS
+               ai16 = (I16)SvIV_no_inf(fromstr, datumtype);
                ai16 = htovs(ai16);
                ai16 = htovs(ai16);
-#endif
-               PUSH16(utf8, cur, &ai16);
+                PUSH16(utf8, cur, &ai16, FALSE);
            }
            break;
         case 'S' | TYPE_IS_SHRIEKING:
 #if SHORTSIZE != SIZE16
            }
            break;
         case 'S' | TYPE_IS_SHRIEKING:
 #if SHORTSIZE != SIZE16
-               while (len-- > 0) {
+           while (len-- > 0) {
                unsigned short aushort;
                unsigned short aushort;
-                   fromstr = NEXTFROM;
-                   aushort = SvUV(fromstr);
-                   DO_BO_PACK(aushort, s);
-               PUSH_VAR(utf8, cur, aushort);
-            }
+               fromstr = NEXTFROM;
+               aushort = SvUV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, aushort, needs_swap);
+           }
             break;
 #else
             break;
 #else
-            /* Fall through! */
+            /* FALLTHROUGH */
 #endif
        case 'S':
 #endif
        case 'S':
-               while (len-- > 0) {
+           while (len-- > 0) {
                U16 au16;
                U16 au16;
-                   fromstr = NEXTFROM;
-                   au16 = (U16)SvUV(fromstr);
-                   DO_BO_PACK(au16, 16);
-               PUSH16(utf8, cur, &au16);
+               fromstr = NEXTFROM;
+               au16 = (U16)SvUV_no_inf(fromstr, datumtype);
+                PUSH16(utf8, cur, &au16, needs_swap);
            }
            break;
        case 's' | TYPE_IS_SHRIEKING:
 #if SHORTSIZE != SIZE16
            }
            break;
        case 's' | TYPE_IS_SHRIEKING:
 #if SHORTSIZE != SIZE16
-               while (len-- > 0) {
+           while (len-- > 0) {
                short ashort;
                short ashort;
-                   fromstr = NEXTFROM;
-                   ashort = SvIV(fromstr);
-                   DO_BO_PACK(ashort, s);
-               PUSH_VAR(utf8, cur, ashort);
+               fromstr = NEXTFROM;
+               ashort = SvIV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, ashort, needs_swap);
            }
             break;
 #else
            }
             break;
 #else
-            /* Fall through! */
+            /* FALLTHROUGH */
 #endif
        case 's':
            while (len-- > 0) {
                I16 ai16;
                fromstr = NEXTFROM;
 #endif
        case 's':
            while (len-- > 0) {
                I16 ai16;
                fromstr = NEXTFROM;
-               ai16 = (I16)SvIV(fromstr);
-               DO_BO_PACK(ai16, 16);
-               PUSH16(utf8, cur, &ai16);
+               ai16 = (I16)SvIV_no_inf(fromstr, datumtype);
+                PUSH16(utf8, cur, &ai16, needs_swap);
            }
            break;
        case 'I':
            }
            break;
        case 'I':
@@ -3117,54 +2850,36 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            while (len-- > 0) {
                unsigned int auint;
                fromstr = NEXTFROM;
            while (len-- > 0) {
                unsigned int auint;
                fromstr = NEXTFROM;
-               auint = SvUV(fromstr);
-               DO_BO_PACK(auint, i);
-               PUSH_VAR(utf8, cur, auint);
+               auint = SvUV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, auint, needs_swap);
            }
            break;
        case 'j':
            while (len-- > 0) {
                IV aiv;
                fromstr = NEXTFROM;
            }
            break;
        case 'j':
            while (len-- > 0) {
                IV aiv;
                fromstr = NEXTFROM;
-               aiv = SvIV(fromstr);
-#if IVSIZE == INTSIZE
-               DO_BO_PACK(aiv, i);
-#elif IVSIZE == LONGSIZE
-               DO_BO_PACK(aiv, l);
-#elif defined(HAS_QUAD) && IVSIZE == U64SIZE
-               DO_BO_PACK(aiv, 64);
-#else
-               Perl_croak(aTHX_ "'j' not supported on this platform");
-#endif
-               PUSH_VAR(utf8, cur, aiv);
+               aiv = SvIV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, aiv, needs_swap);
            }
            break;
        case 'J':
            while (len-- > 0) {
                UV auv;
                fromstr = NEXTFROM;
            }
            break;
        case 'J':
            while (len-- > 0) {
                UV auv;
                fromstr = NEXTFROM;
-               auv = SvUV(fromstr);
-#if UVSIZE == INTSIZE
-               DO_BO_PACK(auv, i);
-#elif UVSIZE == LONGSIZE
-               DO_BO_PACK(auv, l);
-#elif defined(HAS_QUAD) && UVSIZE == U64SIZE
-               DO_BO_PACK(auv, 64);
-#else
-               Perl_croak(aTHX_ "'J' not supported on this platform");
-#endif
-               PUSH_VAR(utf8, cur, auv);
+               auv = SvUV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, auv, needs_swap);
            }
            break;
        case 'w':
             while (len-- > 0) {
                NV anv;
                fromstr = NEXTFROM;
            }
            break;
        case 'w':
             while (len-- > 0) {
                NV anv;
                fromstr = NEXTFROM;
-               anv = SvNV(fromstr);
+               S_sv_check_infnan(aTHX_ fromstr, datumtype);
+               anv = SvNV_nomg(fromstr);
 
                if (anv < 0) {
                    *cur = '\0';
 
                if (anv < 0) {
                    *cur = '\0';
-                   SvCUR(cat) = cur - start;
+                   SvCUR_set(cat, cur - start);
                    Perl_croak(aTHX_ "Cannot compress negative numbers in pack");
                }
 
                    Perl_croak(aTHX_ "Cannot compress negative numbers in pack");
                }
 
@@ -3176,7 +2891,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (SvIOK(fromstr) || anv < UV_MAX_P1) {
                    char   buf[(sizeof(UV)*CHAR_BIT)/7+1];
                    char  *in = buf + sizeof(buf);
                if (SvIOK(fromstr) || anv < UV_MAX_P1) {
                    char   buf[(sizeof(UV)*CHAR_BIT)/7+1];
                    char  *in = buf + sizeof(buf);
-                   UV     auv = SvUV(fromstr);
+                   UV     auv = SvUV_nomg(fromstr);
 
                    do {
                        *--in = (char)((auv & 0x7f) | 0x80);
 
                    do {
                        *--in = (char)((auv & 0x7f) | 0x80);
@@ -3189,7 +2904,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    goto w_string;
                else if (SvNOKp(fromstr)) {
                    /* 10**NV_MAX_10_EXP is the largest power of 10
                    goto w_string;
                else if (SvNOKp(fromstr)) {
                    /* 10**NV_MAX_10_EXP is the largest power of 10
-                      so 10**(NV_MAX_10_EXP+1) is definately unrepresentable
+                      so 10**(NV_MAX_10_EXP+1) is definitely unrepresentable
                       given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x:
                       x = (NV_MAX_10_EXP+1) * log (10) / log (128)
                       And with that many bytes only Inf can overflow.
                       given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x:
                       x = (NV_MAX_10_EXP+1) * log (10) / log (128)
                       And with that many bytes only Inf can overflow.
@@ -3207,9 +2922,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 #endif
                    char  *in = buf + sizeof(buf);
 
 #endif
                    char  *in = buf + sizeof(buf);
 
-                    anv = Perl_floor(anv);
+                   anv = Perl_floor(anv);
                    do {
                    do {
-                       NV next = Perl_floor(anv / 128);
+                       const NV next = Perl_floor(anv / 128);
                        if (in <= buf)  /* this cannot happen ;-) */
                            Perl_croak(aTHX_ "Cannot compress integer in pack");
                        *--in = (unsigned char)(anv - (next * 128)) | 0x80;
                        if (in <= buf)  /* this cannot happen ;-) */
                            Perl_croak(aTHX_ "Cannot compress integer in pack");
                        *--in = (unsigned char)(anv - (next * 128)) | 0x80;
@@ -3219,18 +2934,19 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    PUSH_GROWING_BYTES(utf8, cat, start, cur,
                                       in, (buf + sizeof(buf)) - in);
                } else {
                    PUSH_GROWING_BYTES(utf8, cat, start, cur,
                                       in, (buf + sizeof(buf)) - in);
                } else {
-                   char           *from, *result, *in;
+                   const char     *from;
+                   char           *result, *in;
                    SV             *norm;
                    STRLEN          len;
                    bool            done;
 
                  w_string:
                    /* Copy string and check for compliance */
                    SV             *norm;
                    STRLEN          len;
                    bool            done;
 
                  w_string:
                    /* Copy string and check for compliance */
-                   from = SvPV(fromstr, len);
+                   from = SvPV_nomg_const(fromstr, len);
                    if ((norm = is_an_int(from, len)) == NULL)
                        Perl_croak(aTHX_ "Can only compress unsigned integers in pack");
 
                    if ((norm = is_an_int(from, len)) == NULL)
                        Perl_croak(aTHX_ "Can only compress unsigned integers in pack");
 
-                   New('w', result, len, char);
+                   Newx(result, len, char);
                    in = result + len;
                    done = FALSE;
                    while (!done) *--in = div128(norm, &done) | 0x80;
                    in = result + len;
                    done = FALSE;
                    while (!done) *--in = div128(norm, &done) | 0x80;
@@ -3239,7 +2955,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                                       in, (result + len) - in);
                    Safefree(result);
                    SvREFCNT_dec(norm); /* free norm */
                                       in, (result + len) - in);
                    Safefree(result);
                    SvREFCNT_dec(norm); /* free norm */
-               }
+               }
            }
             break;
        case 'i':
            }
             break;
        case 'i':
@@ -3247,69 +2963,57 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            while (len-- > 0) {
                int aint;
                fromstr = NEXTFROM;
            while (len-- > 0) {
                int aint;
                fromstr = NEXTFROM;
-               aint = SvIV(fromstr);
-               DO_BO_PACK(aint, i);
-               PUSH_VAR(utf8, cur, aint);
+               aint = SvIV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, aint, needs_swap);
            }
            break;
            }
            break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
        case 'N' | TYPE_IS_SHRIEKING:
        case 'N' | TYPE_IS_SHRIEKING:
-#endif
        case 'N':
            while (len-- > 0) {
                U32 au32;
                fromstr = NEXTFROM;
        case 'N':
            while (len-- > 0) {
                U32 au32;
                fromstr = NEXTFROM;
-               au32 = SvUV(fromstr);
-#ifdef HAS_HTONL
+               au32 = SvUV_no_inf(fromstr, datumtype);
                au32 = PerlSock_htonl(au32);
                au32 = PerlSock_htonl(au32);
-#endif
-               PUSH32(utf8, cur, &au32);
+                PUSH32(utf8, cur, &au32, FALSE);
            }
            break;
            }
            break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
        case 'V' | TYPE_IS_SHRIEKING:
        case 'V' | TYPE_IS_SHRIEKING:
-#endif
        case 'V':
            while (len-- > 0) {
                U32 au32;
                fromstr = NEXTFROM;
        case 'V':
            while (len-- > 0) {
                U32 au32;
                fromstr = NEXTFROM;
-               au32 = SvUV(fromstr);
-#ifdef HAS_HTOVL
+               au32 = SvUV_no_inf(fromstr, datumtype);
                au32 = htovl(au32);
                au32 = htovl(au32);
-#endif
-               PUSH32(utf8, cur, &au32);
+                PUSH32(utf8, cur, &au32, FALSE);
            }
            break;
        case 'L' | TYPE_IS_SHRIEKING:
 #if LONGSIZE != SIZE32
            }
            break;
        case 'L' | TYPE_IS_SHRIEKING:
 #if LONGSIZE != SIZE32
-               while (len-- > 0) {
+           while (len-- > 0) {
                unsigned long aulong;
                unsigned long aulong;
-                   fromstr = NEXTFROM;
-                   aulong = SvUV(fromstr);
-                   DO_BO_PACK(aulong, l);
-               PUSH_VAR(utf8, cur, aulong);
+               fromstr = NEXTFROM;
+               aulong = SvUV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, aulong, needs_swap);
            }
            break;
 #else
             /* Fall though! */
 #endif
        case 'L':
            }
            break;
 #else
             /* Fall though! */
 #endif
        case 'L':
-               while (len-- > 0) {
+           while (len-- > 0) {
                U32 au32;
                U32 au32;
-                   fromstr = NEXTFROM;
-                   au32 = SvUV(fromstr);
-                   DO_BO_PACK(au32, 32);
-               PUSH32(utf8, cur, &au32);
+               fromstr = NEXTFROM;
+               au32 = SvUV_no_inf(fromstr, datumtype);
+                PUSH32(utf8, cur, &au32, needs_swap);
            }
            break;
        case 'l' | TYPE_IS_SHRIEKING:
 #if LONGSIZE != SIZE32
            }
            break;
        case 'l' | TYPE_IS_SHRIEKING:
 #if LONGSIZE != SIZE32
-               while (len-- > 0) {
+           while (len-- > 0) {
                long along;
                long along;
-                   fromstr = NEXTFROM;
-                   along = SvIV(fromstr);
-                   DO_BO_PACK(along, l);
-               PUSH_VAR(utf8, cur, along);
+               fromstr = NEXTFROM;
+               along = SvIV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, along, needs_swap);
            }
            break;
 #else
            }
            break;
 #else
@@ -3319,113 +3023,110 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
             while (len-- > 0) {
                I32 ai32;
                fromstr = NEXTFROM;
             while (len-- > 0) {
                I32 ai32;
                fromstr = NEXTFROM;
-               ai32 = SvIV(fromstr);
-               DO_BO_PACK(ai32, 32);
-               PUSH32(utf8, cur, &ai32);
+               ai32 = SvIV_no_inf(fromstr, datumtype);
+                PUSH32(utf8, cur, &ai32, needs_swap);
            }
            break;
            }
            break;
-#ifdef HAS_QUAD
+#if defined(HAS_QUAD) && IVSIZE >= 8
        case 'Q':
            while (len-- > 0) {
                Uquad_t auquad;
                fromstr = NEXTFROM;
        case 'Q':
            while (len-- > 0) {
                Uquad_t auquad;
                fromstr = NEXTFROM;
-               auquad = (Uquad_t) SvUV(fromstr);
-               DO_BO_PACK(auquad, 64);
-               PUSH_VAR(utf8, cur, auquad);
+               auquad = (Uquad_t) SvUV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, auquad, needs_swap);
            }
            break;
        case 'q':
            while (len-- > 0) {
                Quad_t aquad;
                fromstr = NEXTFROM;
            }
            break;
        case 'q':
            while (len-- > 0) {
                Quad_t aquad;
                fromstr = NEXTFROM;
-               aquad = (Quad_t)SvIV(fromstr);
-               DO_BO_PACK(aquad, 64);
-               PUSH_VAR(utf8, cur, aquad);
+               aquad = (Quad_t)SvIV_no_inf(fromstr, datumtype);
+                PUSH_VAR(utf8, cur, aquad, needs_swap);
            }
            break;
            }
            break;
-#endif /* HAS_QUAD */
+#endif
        case 'P':
            len = 1;            /* assume SV is correct length */
            GROWING(utf8, cat, start, cur, sizeof(char *));
        case 'P':
            len = 1;            /* assume SV is correct length */
            GROWING(utf8, cat, start, cur, sizeof(char *));
-           /* Fall through! */
+           /* FALLTHROUGH */
        case 'p':
            while (len-- > 0) {
        case 'p':
            while (len-- > 0) {
-               char *aptr;
+               const char *aptr;
 
                fromstr = NEXTFROM;
                SvGETMAGIC(fromstr);
                if (!SvOK(fromstr)) aptr = NULL;
                else {
 
                fromstr = NEXTFROM;
                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
                     * gone.
                     */
                    /* 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
                     * gone.
                     */
-                   if (ckWARN(WARN_PACK) &&
-                       (SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
-                                            !SvREADONLY(fromstr)))) {
-                       Perl_warner(aTHX_ packWARN(WARN_PACK),
-                               "Attempt to pack pointer to temporary value");
+                   if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1)
+                        || (SvPADTMP(fromstr) &&
+                            !SvREADONLY(fromstr)))) {
+                       Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                                      "Attempt to pack pointer to temporary value");
                    }
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
                    }
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
-                       aptr = SvPV_flags(fromstr, n_a, 0);
+                       aptr = SvPV_nomg_const_nolen(fromstr);
                    else
                    else
-                       aptr = SvPV_force_flags(fromstr, n_a, 0);
+                       aptr = SvPV_force_flags_nolen(fromstr, 0);
                }
                }
-               DO_BO_PACK_P(aptr);
-               PUSH_VAR(utf8, cur, aptr);
+                PUSH_VAR(utf8, cur, aptr, needs_swap);
            }
            break;
            }
            break;
-         case 'u': {
-             char *aptr, *aend;
-             bool from_utf8;
+       case 'u': {
+           const char *aptr, *aend;
+           bool from_utf8;
 
            fromstr = NEXTFROM;
 
            fromstr = NEXTFROM;
-             if (len <= 2) len = 45;
-             else len = len / 3 * 3;
-             if (len >= 64) {
-                 Perl_warner(aTHX_ packWARN(WARN_PACK),
-                             "Field too wide in 'u' format in pack");
-                 len = 63;
-             }
-           aptr = SvPV(fromstr, fromlen);
-             from_utf8 = DO_UTF8(fromstr);
-             if (from_utf8) {
-                 aend = aptr + fromlen;
-                 fromlen = sv_len_utf8(fromstr);
-             } else aend = NULL; /* Unused, but keep compilers happy */
-             GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2);
+           if (len <= 2) len = 45;
+           else len = len / 3 * 3;
+           if (len >= 64) {
+               Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+                              "Field too wide in 'u' format in pack");
+               len = 63;
+           }
+           aptr = SvPV_const(fromstr, fromlen);
+           from_utf8 = DO_UTF8(fromstr);
+           if (from_utf8) {
+               aend = aptr + fromlen;
+               fromlen = sv_len_utf8_nomg(fromstr);
+           } else aend = NULL; /* Unused, but keep compilers happy */
+           GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2);
            while (fromlen > 0) {
            while (fromlen > 0) {
-                 U8 *end;
-               I32 todo;
-                 U8 hunk[1+63/3*4+1];
+               U8 *end;
+               SSize_t todo;
+               U8 hunk[1+63/3*4+1];
 
 
-               if ((I32)fromlen > len)
+               if ((SSize_t)fromlen > len)
                    todo = len;
                else
                    todo = fromlen;
                    todo = len;
                else
                    todo = fromlen;
-                 if (from_utf8) {
-                     char buffer[64];
-                     if (!uni_to_bytes(aTHX_ &aptr, aend, buffer, todo, 
-                                       'u' | TYPE_IS_PACK)) {
-                         *cur = '\0';
-                         SvCUR(cat) = cur - start;
-                         Perl_croak(aTHX_ "Assertion: string is shorter than advertised");
-                     }
-                     end = doencodes(hunk, buffer, todo);
-                 } else {
-                     end = doencodes(hunk, aptr, todo);
-               aptr += todo;
-           }
-                 PUSH_BYTES(utf8, cur, hunk, end-hunk);
-                 fromlen -= todo;
-             }
+               if (from_utf8) {
+                   char buffer[64];
+                   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, "
+                                  "aptr=%p, aend=%p, buffer=%p, todo=%zd",
+                                  aptr, aend, buffer, todo);
+                   }
+                   end = doencodes(hunk, (const U8 *)buffer, todo);
+               } else {
+                   end = doencodes(hunk, (const U8 *)aptr, todo);
+                   aptr += todo;
+               }
+               PUSH_BYTES(utf8, cur, hunk, end-hunk, 0);
+               fromlen -= todo;
+           }
            break;
        }
        }
        *cur = '\0';
            break;
        }
        }
        *cur = '\0';
-       SvCUR(cat) = cur - start;
+       SvCUR_set(cat, cur - start);
       no_change:
        *symptr = lookahead;
     }
       no_change:
        *symptr = lookahead;
     }
@@ -3437,17 +3138,33 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 PP(pp_pack)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
 PP(pp_pack)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
-    register SV *cat = TARG;
+    SV *cat = TARG;
     STRLEN fromlen;
     STRLEN fromlen;
-    register char *pat = SvPVx(*++MARK, fromlen);
-    register char *patend = pat + fromlen;
+    SV *pat_sv = *++MARK;
+    const char *pat = SvPV_const(pat_sv, fromlen);
+    const char *patend = pat + fromlen;
 
     MARK++;
 
     MARK++;
-    sv_setpvn(cat, "", 0);
+    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);
@@ -3455,11 +3172,5 @@ PP(pp_pack)
 }
 
 /*
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: t
- * End:
- *
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 et:
+ */
Unnamed repository; edit this file 'description' to name the repository.