X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9444d2138b6b5264fb9381e43188986db5564e80..fcdf154797de71462d8c8f5606482a86ed73943a:/pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index 7aa95a9..e9969d5 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1,7 +1,7 @@
 /*    pp_pack.c
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 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.
@@ -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.
+ *
+ *     [p.653 of _The Lord of the Rings_, IV/iv: "Of Herbs and Stewed Rabbit"]
  */
 
 /* This file contains pp ("push/pop") functions that
@@ -26,7 +28,6 @@
  * other pp*.c files for the rest of the pp_ functions.
  */
 
-
 #include "EXTERN.h"
 #define PERL_IN_PP_PACK_C
 #include "perl.h"
@@ -69,9 +70,16 @@ typedef struct tempsym {
 	(symptr)->previous = NULL;	\
    } STMT_END
 
-#if PERL_VERSION >= 9
-# define PERL_PACK_CAN_BYTEORDER
-# define PERL_PACK_CAN_SHRIEKSIGN
+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
@@ -145,17 +153,20 @@ typedef struct tempsym {
 #define PUSH32(utf8, cur, p) PUSH_BYTES(utf8, cur, OFF32(p), SIZE32)
 
 /* 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)	\
 STMT_START {						\
     if (utf8) {						\
         if (!uni_to_bytes(aTHX_ &s, strend,		\
-            (char *) &var, sizeof(var), datumtype)) break;\
+	  (char *) (buf), len, datumtype)) break;	\
     } else {						\
-        Copy(s, (char *) &var, sizeof(var), char);	\
-        s += sizeof(var);				\
+        Copy(s, (char *) (buf), len, char);		\
+        s += len;					\
     }							\
 } STMT_END
 
+#define SHIFT_VAR(utf8, s, strend, var, datumtype)	\
+       SHIFT_BYTES(utf8, s, strend, &(var), sizeof(var), datumtype)
+
 #define PUSH_VAR(utf8, aptr, var)	\
 	PUSH_BYTES(utf8, aptr, &(var), sizeof(var))
 
@@ -178,6 +189,8 @@ S_mul128(pTHX_ SV *sv, U8 m)
   char           *s = SvPV(sv, len);
   char           *t;
 
+  PERL_ARGS_ASSERT_MUL128;
+
   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
     SV * const tmpNew = newSVpvs("0000000000");
 
@@ -219,32 +232,6 @@ S_mul128(pTHX_ SV *sv, U8 m)
 #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, post_cast)
-# define DO_BO_PACK_PTR(var, type, pre_cast, post_cast)
-# define DO_BO_UNPACK_N(var, type)
-# define DO_BO_PACK_N(var, type)
-# define DO_BO_UNPACK_P(var)
-# define DO_BO_PACK_P(var)
-# define DO_BO_UNPACK_PC(var)
-# define DO_BO_PACK_PC(var)
-
-#else /* PERL_PACK_CAN_BYTEORDER */
-
 # define TYPE_ENDIANNESS(t)	((t) & TYPE_ENDIANNESS_MASK)
 # define TYPE_NO_ENDIANNESS(t)	((t) & ~TYPE_ENDIANNESS_MASK)
 
@@ -313,23 +300,20 @@ S_mul128(pTHX_ SV *sv, U8 m)
          } STMT_END
 
 # if PTRSIZE == INTSIZE
-#  define DO_BO_UNPACK_P(var)	DO_BO_UNPACK_PTR(var, i, int, void)
-#  define DO_BO_PACK_P(var)	DO_BO_PACK_PTR(var, i, int, void)
 #  define DO_BO_UNPACK_PC(var)	DO_BO_UNPACK_PTR(var, i, int, char)
 #  define DO_BO_PACK_PC(var)	DO_BO_PACK_PTR(var, i, int, char)
 # elif PTRSIZE == LONGSIZE
-#  define DO_BO_UNPACK_P(var)	DO_BO_UNPACK_PTR(var, l, long, void)
-#  define DO_BO_PACK_P(var)	DO_BO_PACK_PTR(var, l, long, void)
-#  define DO_BO_UNPACK_PC(var)	DO_BO_UNPACK_PTR(var, l, long, char)
-#  define DO_BO_PACK_PC(var)	DO_BO_PACK_PTR(var, l, long, char)
+#  if LONGSIZE < IVSIZE && IVSIZE == 8
+#   define DO_BO_UNPACK_PC(var)	DO_BO_UNPACK_PTR(var, 64, IV, char)
+#   define DO_BO_PACK_PC(var)	DO_BO_PACK_PTR(var, 64, IV, char)
+#  else
+#   define DO_BO_UNPACK_PC(var)	DO_BO_UNPACK_PTR(var, l, IV, char)
+#   define DO_BO_PACK_PC(var)	DO_BO_PACK_PTR(var, l, IV, char)
+#  endif
 # elif PTRSIZE == IVSIZE
-#  define DO_BO_UNPACK_P(var)	DO_BO_UNPACK_PTR(var, l, IV, void)
-#  define DO_BO_PACK_P(var)	DO_BO_PACK_PTR(var, l, IV, void)
 #  define DO_BO_UNPACK_PC(var)	DO_BO_UNPACK_PTR(var, l, IV, char)
 #  define DO_BO_PACK_PC(var)	DO_BO_PACK_PTR(var, l, IV, char)
 # else
-#  define DO_BO_UNPACK_P(var)	BO_CANT_DOIT(unpack, pointer)
-#  define DO_BO_PACK_P(var)	BO_CANT_DOIT(pack, pointer)
 #  define DO_BO_UNPACK_PC(var)	BO_CANT_DOIT(unpack, pointer)
 #  define DO_BO_PACK_PC(var)	BO_CANT_DOIT(pack, pointer)
 # endif
@@ -358,261 +342,11 @@ S_mul128(pTHX_ SV *sv, U8 m)
 #  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
 
-/* These tables are regenerated by genpacksizetables.pl (and then hand pasted
-   in).  You're unlikely ever to need to regenerate them.  */
-
-#if TYPE_IS_SHRIEKING != 0x100
-   ++++shriek offset should be 256
-#endif
-
-typedef U8 packprops_t;
-#if 'J'-'I' == 1
-/* ASCII */
-STATIC const packprops_t packprops[512] = {
-    /* normal */
-    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-    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,
-    /* C */ sizeof(unsigned char) | PACK_SIZE_UNPREDICTABLE,
-#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,
-    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, 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, 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, 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,
-    /* shrieking */
-    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, 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, 0, 0, 0,
-    /* 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
-    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, 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, 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, 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
-};
-#else
-/* EBCDIC (or bust) */
-STATIC const packprops_t packprops[512] = {
-    /* normal */
-    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-    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, 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, 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,
-    /* 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) | PACK_SIZE_UNPREDICTABLE,
-#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,
-    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,
-    /* shrieking */
-    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, 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, 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, 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(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
-    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
-};
-#endif
+#include "packsizetables.c"
 
 STATIC U8
 uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
@@ -620,17 +354,16 @@ uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
     STRLEN retlen;
     UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
 			 ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-    /* We try to process malformed UTF-8 as much as possible (preferrably with
+    /* We try to process malformed UTF-8 as much as possible (preferably with
        warnings), but these two mean we make no progress in the string and
        might enter an infinite loop */
     if (retlen == (STRLEN) -1 || retlen == 0)
 	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;
@@ -675,12 +408,12 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len
 	    }
 	    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),
-			"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;
@@ -706,6 +439,8 @@ STATIC char *
 S_bytes_to_uni(const U8 *start, STRLEN len, char *dest) {
     const U8 * const end = start + len;
 
+    PERL_ARGS_ASSERT_BYTES_TO_UNI;
+
     while (start < end) {
 	const UV uv = NATIVE_TO_ASCII(*start);
 	if (UNI_IS_INVARIANT(uv))
@@ -785,6 +520,8 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
 {
     I32 total = 0;
 
+    PERL_ARGS_ASSERT_MEASURE_STRUCT;
+
     while (next_symbol(symptr)) {
 	I32 len;
 	int size;
@@ -809,10 +546,8 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
 		Perl_croak(aTHX_ "Invalid type '%c' in %s",
 			   (int)TYPE_NO_MODIFIERS(symptr->code),
                            _action( symptr ) );
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	    case '.' | TYPE_IS_SHRIEKING:
 	    case '@' | TYPE_IS_SHRIEKING:
-#endif
 	    case '@':
 	    case '.':
 	    case '/':
@@ -892,8 +627,10 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
  * returns char pointer to char after match, or NULL
  */
 STATIC const char *
-S_group_end(pTHX_ register const char *patptr, register const char *patend, char ender)
+S_group_end(pTHX_ const char *patptr, const char *patend, char ender)
 {
+    PERL_ARGS_ASSERT_GROUP_END;
+
     while (patptr < patend) {
 	const char c = *patptr++;
 
@@ -921,9 +658,12 @@ S_group_end(pTHX_ register const char *patptr, register const char *patend, char
  * Advances char pointer to 1st non-digit char and returns number
  */
 STATIC const char *
-S_get_num(pTHX_ register const char *patptr, I32 *lenptr )
+S_get_num(pTHX_ const char *patptr, I32 *lenptr )
 {
   I32 len = *patptr++ - '0';
+
+  PERL_ARGS_ASSERT_GET_NUM;
+
   while (isDIGIT(*patptr)) {
     if (len >= 0x7FFFFFFF/10)
       Perl_croak(aTHX_ "pack/unpack repeat count overflow");
@@ -942,6 +682,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
   const char* patptr = symptr->patptr;
   const char* const patend = symptr->patend;
 
+  PERL_ARGS_ASSERT_NEXT_SYMBOL;
+
   symptr->flags &= ~FLAG_SLASH;
 
   while (patptr < patend) {
@@ -992,9 +734,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
         switch (*patptr) {
           case '!':
             modifier = TYPE_IS_SHRIEKING;
-            allowed = SHRIEKING_ALLOWED_TYPES;
+            allowed = "sSiIlLxXnNvV@.";
             break;
-#ifdef PERL_PACK_CAN_BYTEORDER
           case '>':
             modifier = TYPE_IS_BIG_ENDIAN;
             allowed = ENDIANNESS_ALLOWED_TYPES;
@@ -1003,7 +744,6 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
             modifier = TYPE_IS_LITTLE_ENDIAN;
             allowed = ENDIANNESS_ALLOWED_TYPES;
             break;
-#endif /* PERL_PACK_CAN_BYTEORDER */
           default:
             allowed = "";
             modifier = 0;
@@ -1025,11 +765,11 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
           Perl_croak(aTHX_ "Can't use '%c' in a group with different byte-order in %s",
                      *patptr, _action( symptr ) );
 
-        if ((code & modifier) && ckWARN(WARN_UNPACK)) {
-	    Perl_warner(aTHX_ packWARN(WARN_UNPACK),
-                        "Duplicate modifier '%c' after '%c' in %s",
-                        *patptr, (int) TYPE_NO_MODIFIERS(code),
-                        _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;
@@ -1121,6 +861,9 @@ STATIC bool
 need_utf8(const char *pat, const char *patend)
 {
     bool first = TRUE;
+
+    PERL_ARGS_ASSERT_NEED_UTF8;
+
     while (pat < patend) {
 	if (pat[0] == '#') {
 	    pat++;
@@ -1136,6 +879,8 @@ need_utf8(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++;
@@ -1149,9 +894,21 @@ first_symbol(const char *pat, const char *patend) {
 /*
 =for apidoc unpackstring
 
-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.
+The engine implementing the unpack() Perl function.
+
+Using the template pat..patend, this function unpacks the string
+s..strend into a number of mortal SVs, which it pushes onto the perl
+argument (@_) stack (so you will need to issue a C<PUTBACK> before and
+C<SPAGAIN> after the call to this function). It returns the number of
+pushed elements.
+
+The strend and patend pointers should point to the byte following the last
+character of each string.
+
+Although this function returns its values on the perl argument stack, it
+doesn't take any parameters from that stack (and thus in particular
+there's no need to do a PUSHMARK before calling it, unlike L</call_pv> for
+example).
 
 =cut */
 
@@ -1160,6 +917,8 @@ Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, cons
 {
     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
@@ -1183,10 +942,9 @@ STATIC I32
 S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
 {
     dVAR; dSP;
-    SV *sv;
+    SV *sv = NULL;
     const I32 start_sp_offset = SP - PL_stack_base;
     howlen_t howlen;
-
     I32 checksum = 0;
     UV cuv = 0;
     NV cdouble = 0.0;
@@ -1195,6 +953,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
     bool explicit_length;
     const bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0;
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
+
+    PERL_ARGS_ASSERT_UNPACK_REC;
+
     symptr->strbeg = s - strbeg;
 
     while (next_symbol(symptr)) {
@@ -1259,6 +1020,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    symptr->previous = &savsym;
             symptr->level++;
 	    PUTBACK;
+	    if (len && unpack_only_one) len = 1;
 	    while (len--) {
   	        symptr->patptr = savsym.grpbeg;
 		if (utf8) symptr->flags |=  FLAG_PARSE_UTF8;
@@ -1272,17 +1034,11 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
             *symptr = savsym;
 	    break;
 	}
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case '.' | TYPE_IS_SHRIEKING:
-#endif
 	case '.': {
 	    const char *from;
 	    SV *sv;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	    const bool u8 = utf8 && !(datumtype & TYPE_IS_SHRIEKING);
-#else /* PERL_PACK_CAN_SHRIEKSIGN */
-	    const bool u8 = utf8;
-#endif
 	    if (howlen == e_star) from = strbeg;
 	    else if (len <= 0) from = s;
 	    else {
@@ -1294,19 +1050,13 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    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)));
-	    XPUSHs(sv_2mortal(sv));
+	    mXPUSHs(sv);
 	    break;
 	}
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case '@' | TYPE_IS_SHRIEKING:
-#endif
 	case '@':
 	    s = strbeg + symptr->strbeg;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	    if (utf8  && !(datumtype & TYPE_IS_SHRIEKING))
-#else /* PERL_PACK_CAN_SHRIEKSIGN */
-	    if (utf8)
-#endif
 	    {
 		while (len > 0) {
 		    if (s >= strend)
@@ -1425,7 +1175,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) {
 		    for (ptr = s+len-1; ptr >= s; ptr--)
 			if (*ptr != 0 && !UTF8_IS_CONTINUATION(*ptr) &&
-			    !is_utf8_space((U8 *) ptr)) break;
+			    !isSPACE_utf8(ptr)) break;
 		    if (ptr >= s) ptr += UTF8SKIP(ptr);
 		    else ptr++;
 		    if (ptr > s+len)
@@ -1444,7 +1194,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		if (!(symptr->flags & FLAG_WAS_UTF8))
 		    sv_utf8_downgrade(sv, 0);
 	    }
-	    XPUSHs(sv_2mortal(sv));
+	    mXPUSHs(sv);
 	    s += len;
 	    break;
 	case 'B':
@@ -1453,20 +1203,6 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    if (howlen == e_star || len > (strend - s) * 8)
 		len = (strend - s) * 8;
 	    if (checksum) {
-		if (!PL_bitcount) {
-		    int bits;
-		    Newxz(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) {
 			cuv += PL_bitcount[uni_to_byte(aTHX_ &s, strend, datumtype)];
@@ -1527,13 +1263,15 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	}
 	case 'H':
 	case 'h': {
-	    char *str;
+	    char *str = NULL;
 	    /* Preliminary length estimate, acceptable for utf8 too */
 	    if (howlen == e_star || len > (strend - s) * 2)
 		len = (strend - s) * 2;
-	    sv = sv_2mortal(newSV(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;
 		I32 ai32 = len;
@@ -1543,7 +1281,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			if (s >= strend) break;
 			bits = uni_to_byte(aTHX_ &s, strend, datumtype);
 		    } else bits = * (U8 *) s++;
-		    *str++ = PL_hexdigit[bits & 15];
+		    if (!checksum)
+			*str++ = PL_hexdigit[bits & 15];
 		}
 	    } else {
 		U8 bits = 0;
@@ -1554,39 +1293,52 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			if (s >= strend) break;
 			bits = uni_to_byte(aTHX_ &s, strend, datumtype);
 		    } 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_const(sv));
-	    XPUSHs(sv);
+	    if (!checksum) {
+		*str = '\0';
+		SvCUR_set(sv, str - SvPVX_const(sv));
+		XPUSHs(sv);
+	    }
 	    break;
 	}
+	case 'C':
+            if (len == 0) {
+                if (explicit_length)
+		    /* Switch to "character" mode */
+		    utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0;
+		break;
+	    }
+	    /* FALL THROUGH */
 	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 || retlen == 0)
+			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)
-		    PUSHs(sv_2mortal(newSViv((IV)aint)));
+		    mPUSHi(aint);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)aint;
 		else
 		    cuv += aint;
 	    }
 	    break;
-	case 'C':
 	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) {
 		    STRLEN retlen;
 		    const UV val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
@@ -1595,7 +1347,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			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
@@ -1604,7 +1356,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    } else if (!checksum)
 		while (len-- > 0) {
 		    const U8 ch = *(U8 *) s++;
-		    PUSHs(sv_2mortal(newSVuv((UV) ch)));
+		    mPUSHu(ch);
 	    }
 	    else if (checksum > bits_in_uv)
 		while (len-- > 0) cdouble += (NV) *(U8 *) s++;
@@ -1613,7 +1365,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    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
@@ -1643,16 +1395,16 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    len = UTF8SKIP(result);
 		    if (!uni_to_bytes(aTHX_ &ptr, strend,
 				      (char *) &result[1], len-1, 'U')) break;
-		    auv = utf8n_to_uvuni(result, len, &retlen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV);
+		    auv = utf8n_to_uvuni(result, len, &retlen, UTF8_ALLOW_DEFAULT);
 		    s = ptr;
 		} else {
-		    auv = utf8n_to_uvuni((U8*)s, strend - s, &retlen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV);
+		    auv = utf8n_to_uvuni((U8*)s, strend - s, &retlen, UTF8_ALLOW_DEFAULT);
 		    if (retlen == (STRLEN) -1 || retlen == 0)
 			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
@@ -1666,7 +1418,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, ashort, datumtype);
 		DO_BO_UNPACK(ashort, s);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv((IV)ashort)));
+		    mPUSHi(ashort);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)ashort;
 		else
@@ -1690,7 +1442,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    ai16 -= 65536;
 #endif
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv((IV)ai16)));
+		    mPUSHi(ai16);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)ai16;
 		else
@@ -1704,7 +1456,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, aushort, datumtype);
 		DO_BO_UNPACK(aushort, s);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVuv((UV) aushort)));
+		    mPUSHu(aushort);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)aushort;
 		else
@@ -1712,7 +1464,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    }
 	    break;
 #else
-            /* Fallhrough! */
+            /* Fallthrough! */
 #endif
 	case 'v':
 	case 'n':
@@ -1733,14 +1485,13 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    au16 = vtohs(au16);
 #endif
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVuv((UV)au16)));
+		    mPUSHu(au16);
 		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) {
@@ -1758,14 +1509,13 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    ai16 = (I16) vtohs((U16) ai16);
 # endif /* HAS_VTOHS */
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv((IV)ai16)));
+		    mPUSHi(ai16);
 		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) {
@@ -1773,7 +1523,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, aint, datumtype);
 		DO_BO_UNPACK(aint, i);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv((IV)aint)));
+		    mPUSHi(aint);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)aint;
 		else
@@ -1787,7 +1537,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, auint, datumtype);
 		DO_BO_UNPACK(auint, i);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVuv((UV)auint)));
+		    mPUSHu(auint);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)auint;
 		else
@@ -1808,7 +1558,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		Perl_croak(aTHX_ "'j' not supported on this platform");
 #endif
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv(aiv)));
+		    mPUSHi(aiv);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)aiv;
 		else
@@ -1829,7 +1579,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		Perl_croak(aTHX_ "'J' not supported on this platform");
 #endif
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVuv(auv)));
+		    mPUSHu(auv);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)auv;
 		else
@@ -1843,7 +1593,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, along, datumtype);
 		DO_BO_UNPACK(along, l);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv((IV)along)));
+		    mPUSHi(along);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)along;
 		else
@@ -1865,7 +1615,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		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
@@ -1879,7 +1629,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, aulong, datumtype);
 		DO_BO_UNPACK(aulong, l);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVuv((UV)aulong)));
+		    mPUSHu(aulong);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)aulong;
 		else
@@ -1908,46 +1658,44 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    au32 = vtohl(au32);
 #endif
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVuv((UV)au32)));
+		    mPUSHu(au32);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)au32;
 		else
 		    cuv += au32;
 	    }
 	    break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case 'V' | TYPE_IS_SHRIEKING:
 	case 'N' | TYPE_IS_SHRIEKING:
 	    while (len-- > 0) {
 		I32 ai32;
-# if U32SIZE > SIZE32
+#if U32SIZE > SIZE32
 		ai32 = 0;
-# endif
+#endif
 		SHIFT32(utf8, s, strend, &ai32, datumtype);
-# ifdef HAS_NTOHL
+#ifdef HAS_NTOHL
 		if (datumtype == ('N' | TYPE_IS_SHRIEKING))
 		    ai32 = (I32)PerlSock_ntohl((U32)ai32);
-# endif
-# ifdef HAS_VTOHL
+#endif
+#ifdef HAS_VTOHL
 		if (datumtype == ('V' | TYPE_IS_SHRIEKING))
 		    ai32 = (I32)vtohl((U32)ai32);
-# endif
+#endif
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv((IV)ai32)));
+		    mPUSHi(ai32);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)ai32;
 		else
 		    cuv += ai32;
 	    }
 	    break;
-#endif /* PERL_PACK_CAN_SHRIEKSIGN */
 	case 'p':
 	    while (len-- > 0) {
 		const char *aptr;
 		SHIFT_VAR(utf8, s, strend, aptr, datumtype);
 		DO_BO_UNPACK_PC(aptr);
 		/* newSVpv generates undef if aptr is NULL */
-		PUSHs(sv_2mortal(newSVpv(aptr, 0)));
+		mPUSHs(newSVpv(aptr, 0));
 	    }
 	    break;
 	case 'w':
@@ -1962,7 +1710,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    /* UTF8_IS_XXXXX not right here - using constant 0x80 */
 		    if (ch < 0x80) {
 			bytes = 0;
-			PUSHs(sv_2mortal(newSVuv(auv)));
+			mPUSHu(auv);
 			len--;
 			auv = 0;
 			continue;
@@ -1983,7 +1731,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			while (*t == '0')
 			    t++;
 			sv_chop(sv, t);
-			PUSHs(sv_2mortal(sv));
+			mPUSHs(sv);
 			len--;
 			auv = 0;
 		    }
@@ -2001,7 +1749,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, aptr, datumtype);
 		DO_BO_UNPACK_PC(aptr);
 		/* newSVpvn generates undef if aptr is NULL */
-		PUSHs(sv_2mortal(newSVpvn(aptr, len)));
+		PUSHs(newSVpvn_flags(aptr, len, SVs_TEMP));
 	    }
 	    break;
 #ifdef HAS_QUAD
@@ -2011,8 +1759,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, aquad, datumtype);
 		DO_BO_UNPACK(aquad, 64);
 		if (!checksum)
-                    PUSHs(sv_2mortal(aquad >= IV_MIN && aquad <= IV_MAX ?
-				     newSViv((IV)aquad) : newSVnv((NV)aquad)));
+                    mPUSHs(aquad >= IV_MIN && aquad <= IV_MAX ?
+			   newSViv((IV)aquad) : newSVnv((NV)aquad));
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)aquad;
 		else
@@ -2025,8 +1773,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, auquad, datumtype);
 		DO_BO_UNPACK(auquad, 64);
 		if (!checksum)
-		    PUSHs(sv_2mortal(auquad <= UV_MAX ?
-				     newSVuv((UV)auquad):newSVnv((NV)auquad)));
+		    mPUSHs(auquad <= UV_MAX ?
+			   newSVuv((UV)auquad) : newSVnv((NV)auquad));
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)auquad;
 		else
@@ -2041,7 +1789,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, afloat, datumtype);
 		DO_BO_UNPACK_N(afloat, float);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVnv((NV)afloat)));
+		    mPUSHn(afloat);
 		else
 		    cdouble += afloat;
 	    }
@@ -2052,37 +1800,37 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		SHIFT_VAR(utf8, s, strend, adouble, datumtype);
 		DO_BO_UNPACK_N(adouble, double);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVnv((NV)adouble)));
+		    mPUSHn(adouble);
 		else
 		    cdouble += adouble;
 	    }
 	    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);
+		DO_BO_UNPACK_N(anv.nv, NV);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVnv(anv)));
+		    mPUSHn(anv.nv);
 		else
-		    cdouble += anv;
+		    cdouble += anv.nv;
 	    }
 	    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);
+		DO_BO_UNPACK_N(aldouble.ld, long double);
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVnv((NV)aldouble)));
+		    mPUSHn(aldouble.ld);
 		else
-		    cdouble += aldouble;
+		    cdouble += aldouble.ld;
 	    }
 	    break;
 #endif
 	case 'u':
-	    {
+	    if (!checksum) {
                 const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
 		sv = sv_2mortal(newSV(l));
 		if (l) SvPOK_on(sv);
@@ -2100,7 +1848,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			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);
+			if (!checksum)
+			    sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
 			len -= 3;
 		    }
 		    if (s < strend) {
@@ -2141,7 +1890,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			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);
+			if (!checksum)
+			    sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
 			len -= 3;
 		    }
 		    if (*s == '\n')
@@ -2151,7 +1901,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			    s += 2;
 		}
 	    }
-	    XPUSHs(sv);
+	    if (!checksum)
+		XPUSHs(sv);
 	    break;
 	}
 
@@ -2178,13 +1929,13 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		}
 		sv = newSVuv(cuv);
 	    }
-	    XPUSHs(sv_2mortal(sv));
+	    mXPUSHs(sv);
 	    checksum = 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" );
@@ -2269,6 +2020,8 @@ S_is_an_int(pTHX_ const char *s, STRLEN l)
   bool skip = 1;
   bool ignore = 0;
 
+  PERL_ARGS_ASSERT_IS_AN_INT;
+
   while (*s) {
     switch (*s) {
     case ' ':
@@ -2317,6 +2070,8 @@ S_div128(pTHX_ SV *pnum, bool *done)
     char *t = s;
     int m = 0;
 
+    PERL_ARGS_ASSERT_DIV128;
+
     *done = 1;
     while (*t) {
 	const int i = m * 10 + (*t - '0');
@@ -2341,11 +2096,13 @@ The engine implementing pack() Perl function.
 */
 
 void
-Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist )
+Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist )
 {
     dVAR;
     tempsym_t sym;
 
+    PERL_ARGS_ASSERT_PACKLIST;
+
     TEMPSYM_INIT(&sym, pat, patend, FLAG_PACK);
 
     /* We're going to do changes through SvPVX(cat). Make sure it's valid.
@@ -2399,7 +2156,8 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
     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;
@@ -2430,6 +2188,9 @@ S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
     const STRLEN cur = SvCUR(sv);
     const STRLEN len = SvLEN(sv);
     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);
@@ -2446,6 +2207,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
     bool warn_utf8 = ckWARN(WARN_UTF8);
 
+    PERL_ARGS_ASSERT_PACK_REC;
+
     if (symptr->level == 0 && found && symptr->code == 'U') {
 	marked_upgrade(aTHX_ cat, symptr);
 	symptr->flags |= FLAG_DO_UTF8;
@@ -2496,18 +2259,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		if (lookahead.howlen == e_number) count = lookahead.length;
 		else {
 		    if (items > 0) {
-			if (SvGAMAGIC(*beglist)) {
-			    /* Avoid reading the active data more than once
-			       by copying it to a temporary.  */
-			    STRLEN len;
-			    const char *const pv = SvPV_const(*beglist, len);
-			    SV *const temp = sv_2mortal(newSVpvn(pv, len));
-			    if (SvUTF8(*beglist))
-				SvUTF8_on(temp);
-			    *beglist = temp;
-			}
-			count = DO_UTF8(*beglist) ?
-			    sv_len_utf8(*beglist) : sv_len(*beglist);
+			count = sv_len_utf8(*beglist);
 		    }
 		    else count = 0;
 		    if (lookahead.code == 'Z') count++;
@@ -2533,9 +2285,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    Perl_croak(aTHX_ "'%%' may not be used in pack");
 	{
 	    char *from;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case '.' | TYPE_IS_SHRIEKING:
-#endif
 	case '.':
 	    if (howlen == e_star) from = start;
 	    else if (len == 0) from = cur;
@@ -2548,17 +2298,11 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    fromstr = NEXTFROM;
 	    len = SvIV(fromstr);
 	    goto resize;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case '@' | TYPE_IS_SHRIEKING:
-#endif
 	case '@':
 	    from = start + symptr->strbeg;
 	  resize:
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	    if (utf8  && !(datumtype & TYPE_IS_SHRIEKING))
-#else /* PERL_PACK_CAN_SHRIEKSIGN */
-	    if (utf8)
-#endif
 		if (len >= 0) {
 		    while (len && from < cur) {
 			from += UTF8SKIP(from);
@@ -2728,7 +2472,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		GROWING(0, cat, start, cur, len);
 		if (!uni_to_bytes(aTHX_ &aptr, end, cur, fromlen,
 				  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=%"UVuf,
+			       (int)datumtype, aptr, end, cur, (UV)fromlen);
 		cur += fromlen;
 		len -= fromlen;
 	    } else if (utf8) {
@@ -2767,6 +2513,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    }
 	    memset(cur, datumtype == 'A' ? ' ' : '\0', len);
 	    cur += len;
+	    SvTAINT(cat);
 	    break;
 	}
 	case 'B':
@@ -2918,10 +2665,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		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");
+		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;
@@ -2930,16 +2676,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0;
 		break;
 	    }
-	    GROWING(0, cat, start, cur, len);
 	    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++ = (char)(aiv & 0xff);
+		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': {
@@ -2980,9 +2724,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 			    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");
+			Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+				       "Character in 'W' format wrapped in pack");
 			auv &= 0xff;
 		    }
 		    if (cur >= end) {
@@ -3049,20 +2792,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		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)
 		/* IEEE fp overflow shenanigans are unavailable on VAX and optional
 		 * on Alpha; fake it if we don't have them.
 		 */
@@ -3074,7 +2804,6 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 # else
 		afloat = (float)anv;
 # endif
-#endif /* __VOS__ */
 		DO_BO_PACK_N(afloat, float);
 		PUSH_VAR(utf8, cur, afloat);
 	    }
@@ -3085,20 +2814,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		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)
 		/* IEEE fp overflow shenanigans are unavailable on VAX and optional
 		 * on Alpha; fake it if we don't have them.
 		 */
@@ -3110,39 +2826,46 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 # else
 		adouble = (double)anv;
 # endif
-#endif /* __VOS__ */
 		DO_BO_PACK_N(adouble, double);
 		PUSH_VAR(utf8, cur, adouble);
 	    }
 	    break;
 	case 'F': {
-	    NV anv;
+	    NV_bytes anv;
 	    Zero(&anv, 1, NV); /* can be long double with unused bits */
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		anv = SvNV(fromstr);
+#ifdef __GNUC__
+		/* to work round a gcc/x86 bug; don't use SvNV */
+		anv.nv = sv_2nv(fromstr);
+#else
+		anv.nv = SvNV(fromstr);
+#endif
 		DO_BO_PACK_N(anv, NV);
-		PUSH_VAR(utf8, cur, anv);
+		PUSH_BYTES(utf8, cur, anv.bytes, sizeof(anv.bytes));
 	    }
 	    break;
 	}
 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
 	case 'D': {
-	    long double aldouble;
+	    ld_bytes aldouble;
 	    /* 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);
+#  ifdef __GNUC__
+		/* to work round a gcc/x86 bug; don't use SvNV */
+		aldouble.ld = (long double)sv_2nv(fromstr);
+#  else
+		aldouble.ld = (long double)SvNV(fromstr);
+#  endif
 		DO_BO_PACK_N(aldouble, long double);
-		PUSH_VAR(utf8, cur, aldouble);
+		PUSH_BYTES(utf8, cur, aldouble.bytes, sizeof(aldouble.bytes));
 	    }
 	    break;
 	}
 #endif
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case 'n' | TYPE_IS_SHRIEKING:
-#endif
 	case 'n':
 	    while (len-- > 0) {
 		I16 ai16;
@@ -3154,9 +2877,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		PUSH16(utf8, cur, &ai16);
 	    }
 	    break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case 'v' | TYPE_IS_SHRIEKING:
-#endif
 	case 'v':
 	    while (len-- > 0) {
 		I16 ai16;
@@ -3289,7 +3010,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
-		       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.
@@ -3353,9 +3074,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		PUSH_VAR(utf8, cur, aint);
 	    }
 	    break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case 'N' | TYPE_IS_SHRIEKING:
-#endif
 	case 'N':
 	    while (len-- > 0) {
 		U32 au32;
@@ -3367,9 +3086,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		PUSH32(utf8, cur, &au32);
 	    }
 	    break;
-#ifdef PERL_PACK_CAN_SHRIEKSIGN
 	case 'V' | TYPE_IS_SHRIEKING:
-#endif
 	case 'V':
 	    while (len-- > 0) {
 		U32 au32;
@@ -3463,9 +3180,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		     * gone.
 		     */
 		    if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
-			     !SvREADONLY(fromstr))) && ckWARN(WARN_PACK)) {
-			Perl_warner(aTHX_ packWARN(WARN_PACK),
-				    "Attempt to pack pointer to temporary value");
+			     !SvREADONLY(fromstr)))) {
+			Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
+				       "Attempt to pack pointer to temporary value");
 		    }
 		    if (SvPOK(fromstr) || SvNIOK(fromstr))
 			aptr = SvPV_nomg_const_nolen(fromstr);
@@ -3484,16 +3201,15 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    if (len <= 2) len = 45;
 	    else len = len / 3 * 3;
 	    if (len >= 64) {
-		if (ckWARN(WARN_PACK))
-		    Perl_warner(aTHX_ packWARN(WARN_PACK),
-			    "Field too wide in 'u' format in pack");
+		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(fromstr);
+		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) {
@@ -3511,7 +3227,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 				      'u' | TYPE_IS_PACK)) {
 			*cur = '\0';
 			SvCUR_set(cat, cur - start);
-			Perl_croak(aTHX_ "Assertion: string is shorter than advertised");
+			Perl_croak(aTHX_ "panic: string is shorter than advertised, "
+				   "aptr=%p, aend=%p, buffer=%p, todo=%ld",
+				   aptr, aend, buffer, (long) todo);
 		    }
 		    end = doencodes(hunk, buffer, todo);
 		} else {
@@ -3537,14 +3255,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 PP(pp_pack)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    register SV *cat = TARG;
+    SV *cat = TARG;
     STRLEN fromlen;
     SV *pat_sv = *++MARK;
-    register const char *pat = SvPV_const(pat_sv, fromlen);
-    register const char *patend = pat + fromlen;
+    const char *pat = SvPV_const(pat_sv, fromlen);
+    const char *patend = pat + fromlen;
 
     MARK++;
-    sv_setpvn(cat, "", 0);
+    sv_setpvs(cat, "");
     SvUTF8_off(cat);
 
     packlist(cat, pat, patend, MARK, SP + 1);
@@ -3559,8 +3277,8 @@ PP(pp_pack)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */