X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_pack.c;h=9ac9e3de84dc15cd02cd4bc008bb1de52cb3cac1;hb=13.2-releng;hp=21e6494d2ff8509e4800c2a789796fc13fb99170;hpb=59cd0e26eb6c10499b25d783562357dd68cc16f2;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_pack.c b/pp_pack.c
index 21e6494..9ac9e3d 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, 2007, 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
@@ -68,6 +70,18 @@ typedef struct tempsym {
 	(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
+
 #if PERL_VERSION >= 9
 # define PERL_PACK_CAN_BYTEORDER
 # define PERL_PACK_CAN_SHRIEKSIGN
@@ -144,17 +158,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))
 
@@ -177,6 +194,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");
 
@@ -317,10 +336,17 @@ S_mul128(pTHX_ SV *sv, U8 m)
 #  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_P(var)	DO_BO_UNPACK_PTR(var, 64, IV, void)
+#   define DO_BO_PACK_P(var)	DO_BO_PACK_PTR(var, 64, IV, void)
+#   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_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)
+#  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)
@@ -626,10 +652,9 @@ uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
 	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;
@@ -674,12 +699,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;
@@ -705,6 +730,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))
@@ -784,6 +811,8 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
 {
     I32 total = 0;
 
+    PERL_ARGS_ASSERT_MEASURE_STRUCT;
+
     while (next_symbol(symptr)) {
 	I32 len;
 	int size;
@@ -893,6 +922,8 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
 STATIC const char *
 S_group_end(pTHX_ register const char *patptr, register const char *patend, char ender)
 {
+    PERL_ARGS_ASSERT_GROUP_END;
+
     while (patptr < patend) {
 	const char c = *patptr++;
 
@@ -923,6 +954,9 @@ STATIC const char *
 S_get_num(pTHX_ register 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");
@@ -941,6 +975,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) {
@@ -1024,11 +1060,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;
@@ -1120,6 +1156,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++;
@@ -1135,6 +1174,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++;
@@ -1159,6 +1200,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
@@ -1182,10 +1225,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;
@@ -1194,6 +1236,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)) {
@@ -1258,6 +1303,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;
@@ -1293,7 +1339,7 @@ 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
@@ -1443,7 +1489,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':
@@ -1452,20 +1498,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)];
@@ -1526,13 +1558,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;
@@ -1542,7 +1576,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;
@@ -1553,12 +1588,15 @@ 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':
@@ -1586,7 +1624,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		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
@@ -1604,7 +1642,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
@@ -1613,7 +1651,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++;
@@ -1661,7 +1699,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    s += retlen;
 		}
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSVuv((UV) auv)));
+		    mPUSHu(auv);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV) auv;
 		else
@@ -1675,7 +1713,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
@@ -1699,7 +1737,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
@@ -1713,7 +1751,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
@@ -1742,7 +1780,7 @@ 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
@@ -1767,7 +1805,7 @@ 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
@@ -1782,7 +1820,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
@@ -1796,7 +1834,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
@@ -1817,7 +1855,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
@@ -1838,7 +1876,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
@@ -1852,7 +1890,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
@@ -1874,7 +1912,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
@@ -1888,7 +1926,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
@@ -1917,7 +1955,7 @@ 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
@@ -1942,7 +1980,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 		    ai32 = (I32)vtohl((U32)ai32);
 # endif
 		if (!checksum)
-		    PUSHs(sv_2mortal(newSViv((IV)ai32)));
+		    mPUSHi(ai32);
 		else if (checksum > bits_in_uv)
 		    cdouble += (NV)ai32;
 		else
@@ -1956,7 +1994,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);
 		/* newSVpv generates undef if aptr is NULL */
-		PUSHs(sv_2mortal(newSVpv(aptr, 0)));
+		mPUSHs(newSVpv(aptr, 0));
 	    }
 	    break;
 	case 'w':
@@ -1971,7 +2009,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;
@@ -1992,7 +2030,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;
 		    }
@@ -2020,8 +2058,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
@@ -2034,8 +2072,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
@@ -2050,7 +2088,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;
 	    }
@@ -2061,37 +2099,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);
@@ -2109,7 +2147,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) {
@@ -2150,7 +2189,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')
@@ -2160,7 +2200,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;
 	}
 
@@ -2187,7 +2228,7 @@ 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;
 	}
 
@@ -2278,6 +2319,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 ' ':
@@ -2326,6 +2369,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');
@@ -2355,6 +2400,8 @@ Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **
     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.
@@ -2408,7 +2455,7 @@ 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");
     }
     for (group=sym_ptr; group; group = group->previous)
 	group->strbeg = marks[group->level] - to_start;
@@ -2439,6 +2486,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);
@@ -2455,6 +2505,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;
@@ -2737,7 +2789,7 @@ 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");
 		cur += fromlen;
 		len -= fromlen;
 	    } else if (utf8) {
@@ -2776,6 +2828,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':
@@ -2927,10 +2980,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;
@@ -2943,10 +2995,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		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");
+		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;
@@ -2988,9 +3039,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) {
@@ -3064,11 +3114,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		   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.  */
+{
+extern const float _float_constants[];
 		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)
 		/* IEEE fp overflow shenanigans are unavailable on VAX and optional
@@ -3100,11 +3153,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 		   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.  */
+{
+extern const double _double_constants[];
 		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)
 		/* IEEE fp overflow shenanigans are unavailable on VAX and optional
@@ -3124,26 +3180,26 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    }
 	    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);
+		anv.nv = SvNV(fromstr);
 		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);
+		aldouble.ld = (long double)SvNV(fromstr);
 		DO_BO_PACK_N(aldouble, long double);
-		PUSH_VAR(utf8, cur, aldouble);
+		PUSH_BYTES(utf8, cur, aldouble.bytes, sizeof(aldouble.bytes));
 	    }
 	    break;
 	}
@@ -3471,9 +3527,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);
@@ -3492,9 +3548,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    if (len <= 2) len = 45;
 	    else len = len / 3 * 3;
 	    if (len >= 64) {
-		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);
@@ -3519,7 +3574,7 @@ 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");
 		    }
 		    end = doencodes(hunk, buffer, todo);
 		} else {
@@ -3552,7 +3607,7 @@ PP(pp_pack)
     register const char *patend = pat + fromlen;
 
     MARK++;
-    sv_setpvn(cat, "", 0);
+    sv_setpvs(cat, "");
     SvUTF8_off(cat);
 
     packlist(cat, pat, patend, MARK, SP + 1);