byte-order modifiers for (un)pack templates
Marcus Holland-Moritz [Wed, 21 Apr 2004 21:09:20 +0000 (23:09 +0200)]
Message-Id: <20040421210920.3c467772@r2d2>

p4raw-id: //depot/perl@22734

embed.fnc
embed.h
perl.h
pod/perldiag.pod
pod/perlfunc.pod
pod/perlport.pod
pp_pack.c
proto.h
t/op/pack.t
util.c

index 49e6052..8e0b5ca 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1404,4 +1404,80 @@ Apd      |void   |hv_clear_placeholders|HV* hb
 Apd    |SV*    |hv_scalar      |HV* hv|
 p      |SV*    |magic_scalarpack|HV* hv|MAGIC* mg
 
+#ifdef PERL_NEED_MY_HTOLE16
+np     |U16    |my_htole16     |U16 n
+#endif
+#ifdef PERL_NEED_MY_LETOH16
+np     |U16    |my_letoh16     |U16 n
+#endif
+#ifdef PERL_NEED_MY_HTOBE16
+np     |U16    |my_htobe16     |U16 n
+#endif
+#ifdef PERL_NEED_MY_BETOH16
+np     |U16    |my_betoh16     |U16 n
+#endif
+#ifdef PERL_NEED_MY_HTOLE32
+np     |U32    |my_htole32     |U32 n
+#endif
+#ifdef PERL_NEED_MY_LETOH32
+np     |U32    |my_letoh32     |U32 n
+#endif
+#ifdef PERL_NEED_MY_HTOBE32
+np     |U32    |my_htobe32     |U32 n
+#endif
+#ifdef PERL_NEED_MY_BETOH32
+np     |U32    |my_betoh32     |U32 n
+#endif
+#ifdef PERL_NEED_MY_HTOLE64
+np     |U64    |my_htole64     |U64 n
+#endif
+#ifdef PERL_NEED_MY_LETOH64
+np     |U64    |my_letoh64     |U64 n
+#endif
+#ifdef PERL_NEED_MY_HTOBE64
+np     |U64    |my_htobe64     |U64 n
+#endif
+#ifdef PERL_NEED_MY_BETOH64
+np     |U64    |my_betoh64     |U64 n
+#endif
+
+#ifdef PERL_NEED_MY_HTOLES
+np     |short  |my_htoles      |short n
+#endif
+#ifdef PERL_NEED_MY_LETOHS
+np     |short  |my_letohs      |short n
+#endif
+#ifdef PERL_NEED_MY_HTOBES
+np     |short  |my_htobes      |short n
+#endif
+#ifdef PERL_NEED_MY_BETOHS
+np     |short  |my_betohs      |short n
+#endif
+#ifdef PERL_NEED_MY_HTOLEI
+np     |int    |my_htolei      |int n
+#endif
+#ifdef PERL_NEED_MY_LETOHI
+np     |int    |my_letohi      |int n
+#endif
+#ifdef PERL_NEED_MY_HTOBEI
+np     |int    |my_htobei      |int n
+#endif
+#ifdef PERL_NEED_MY_BETOHI
+np     |int    |my_betohi      |int n
+#endif
+#ifdef PERL_NEED_MY_HTOLEL
+np     |long   |my_htolel      |long n
+#endif
+#ifdef PERL_NEED_MY_LETOHL
+np     |long   |my_letohl      |long n
+#endif
+#ifdef PERL_NEED_MY_HTOBEL
+np     |long   |my_htobel      |long n
+#endif
+#ifdef PERL_NEED_MY_BETOHL
+np     |long   |my_betohl      |long n
+#endif
+
+np     |void   |my_swabn       |void* ptr|int n
+
 END_EXTERN_C
diff --git a/embed.h b/embed.h
index 808e010..3de8118 100644 (file)
--- a/embed.h
+++ b/embed.h
 #ifdef PERL_CORE
 #define magic_scalarpack       Perl_magic_scalarpack
 #endif
+#ifdef PERL_NEED_MY_HTOLE16
+#ifdef PERL_CORE
+#define my_htole16             Perl_my_htole16
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOH16
+#ifdef PERL_CORE
+#define my_letoh16             Perl_my_letoh16
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE16
+#ifdef PERL_CORE
+#define my_htobe16             Perl_my_htobe16
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOH16
+#ifdef PERL_CORE
+#define my_betoh16             Perl_my_betoh16
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLE32
+#ifdef PERL_CORE
+#define my_htole32             Perl_my_htole32
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOH32
+#ifdef PERL_CORE
+#define my_letoh32             Perl_my_letoh32
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE32
+#ifdef PERL_CORE
+#define my_htobe32             Perl_my_htobe32
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOH32
+#ifdef PERL_CORE
+#define my_betoh32             Perl_my_betoh32
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLE64
+#ifdef PERL_CORE
+#define my_htole64             Perl_my_htole64
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOH64
+#ifdef PERL_CORE
+#define my_letoh64             Perl_my_letoh64
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE64
+#ifdef PERL_CORE
+#define my_htobe64             Perl_my_htobe64
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOH64
+#ifdef PERL_CORE
+#define my_betoh64             Perl_my_betoh64
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLES
+#ifdef PERL_CORE
+#define my_htoles              Perl_my_htoles
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOHS
+#ifdef PERL_CORE
+#define my_letohs              Perl_my_letohs
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBES
+#ifdef PERL_CORE
+#define my_htobes              Perl_my_htobes
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOHS
+#ifdef PERL_CORE
+#define my_betohs              Perl_my_betohs
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLEI
+#ifdef PERL_CORE
+#define my_htolei              Perl_my_htolei
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOHI
+#ifdef PERL_CORE
+#define my_letohi              Perl_my_letohi
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBEI
+#ifdef PERL_CORE
+#define my_htobei              Perl_my_htobei
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOHI
+#ifdef PERL_CORE
+#define my_betohi              Perl_my_betohi
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLEL
+#ifdef PERL_CORE
+#define my_htolel              Perl_my_htolel
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOHL
+#ifdef PERL_CORE
+#define my_letohl              Perl_my_letohl
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBEL
+#ifdef PERL_CORE
+#define my_htobel              Perl_my_htobel
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOHL
+#ifdef PERL_CORE
+#define my_betohl              Perl_my_betohl
+#endif
+#endif
+#ifdef PERL_CORE
+#define my_swabn               Perl_my_swabn
+#endif
 #define ck_anoncode            Perl_ck_anoncode
 #define ck_bitop               Perl_ck_bitop
 #define ck_concat              Perl_ck_concat
 #ifdef PERL_CORE
 #define magic_scalarpack(a,b)  Perl_magic_scalarpack(aTHX_ a,b)
 #endif
+#ifdef PERL_NEED_MY_HTOLE16
+#ifdef PERL_CORE
+#define my_htole16             Perl_my_htole16
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOH16
+#ifdef PERL_CORE
+#define my_letoh16             Perl_my_letoh16
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE16
+#ifdef PERL_CORE
+#define my_htobe16             Perl_my_htobe16
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOH16
+#ifdef PERL_CORE
+#define my_betoh16             Perl_my_betoh16
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLE32
+#ifdef PERL_CORE
+#define my_htole32             Perl_my_htole32
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOH32
+#ifdef PERL_CORE
+#define my_letoh32             Perl_my_letoh32
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE32
+#ifdef PERL_CORE
+#define my_htobe32             Perl_my_htobe32
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOH32
+#ifdef PERL_CORE
+#define my_betoh32             Perl_my_betoh32
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLE64
+#ifdef PERL_CORE
+#define my_htole64             Perl_my_htole64
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOH64
+#ifdef PERL_CORE
+#define my_letoh64             Perl_my_letoh64
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE64
+#ifdef PERL_CORE
+#define my_htobe64             Perl_my_htobe64
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOH64
+#ifdef PERL_CORE
+#define my_betoh64             Perl_my_betoh64
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLES
+#ifdef PERL_CORE
+#define my_htoles              Perl_my_htoles
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOHS
+#ifdef PERL_CORE
+#define my_letohs              Perl_my_letohs
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBES
+#ifdef PERL_CORE
+#define my_htobes              Perl_my_htobes
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOHS
+#ifdef PERL_CORE
+#define my_betohs              Perl_my_betohs
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLEI
+#ifdef PERL_CORE
+#define my_htolei              Perl_my_htolei
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOHI
+#ifdef PERL_CORE
+#define my_letohi              Perl_my_letohi
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBEI
+#ifdef PERL_CORE
+#define my_htobei              Perl_my_htobei
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOHI
+#ifdef PERL_CORE
+#define my_betohi              Perl_my_betohi
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOLEL
+#ifdef PERL_CORE
+#define my_htolel              Perl_my_htolel
+#endif
+#endif
+#ifdef PERL_NEED_MY_LETOHL
+#ifdef PERL_CORE
+#define my_letohl              Perl_my_letohl
+#endif
+#endif
+#ifdef PERL_NEED_MY_HTOBEL
+#ifdef PERL_CORE
+#define my_htobel              Perl_my_htobel
+#endif
+#endif
+#ifdef PERL_NEED_MY_BETOHL
+#ifdef PERL_CORE
+#define my_betohl              Perl_my_betohl
+#endif
+#endif
+#ifdef PERL_CORE
+#define my_swabn               Perl_my_swabn
+#endif
 #define ck_anoncode(a)         Perl_ck_anoncode(aTHX_ a)
 #define ck_bitop(a)            Perl_ck_bitop(aTHX_ a)
 #define ck_concat(a)           Perl_ck_concat(aTHX_ a)
diff --git a/perl.h b/perl.h
index 3d86da4..7b9a51a 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -449,6 +449,241 @@ int usleep(unsigned int);
 #  define MYSWAP
 #endif
 
+#ifdef PERL_CORE
+
+/* macros for correct constant construction */
+# if INTSIZE >= 2
+#  define U16_CONST(x) ((U16)x##U)
+# else
+#  define U16_CONST(x) ((U16)x##UL)
+# endif
+
+# if INTSIZE >= 4
+#  define U32_CONST(x) ((U32)x##U)
+# else
+#  define U32_CONST(x) ((U32)x##UL)
+# endif
+
+# ifdef HAS_QUAD
+#  if INTSIZE >= 8
+#   define U64_CONST(x) ((U64)x##U)
+#  elif LONGSIZE >= 8
+#   define U64_CONST(x) ((U64)x##UL)
+#  elif QUADKIND == QUAD_IS_LONG_LONG
+#   define U64_CONST(x) ((U64)x##ULL)
+#  else /* best guess we can make */
+#   define U64_CONST(x) ((U64)x##UL)
+#  endif
+# endif
+
+/* byte-swapping functions for big-/little-endian conversion */
+# define _swab_16_(x) ((U16)( \
+         (((U16)(x) & U16_CONST(0x00ff)) << 8) | \
+         (((U16)(x) & U16_CONST(0xff00)) >> 8) ))
+
+# define _swab_32_(x) ((U32)( \
+         (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \
+         (((U32)(x) & U32_CONST(0x0000ff00)) <<  8) | \
+         (((U32)(x) & U32_CONST(0x00ff0000)) >>  8) | \
+         (((U32)(x) & U32_CONST(0xff000000)) >> 24) ))
+
+# ifdef HAS_QUAD
+#  define _swab_64_(x) ((U64)( \
+          (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \
+          (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \
+          (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \
+          (((U64)(x) & U64_CONST(0x00000000ff000000)) <<  8) | \
+          (((U64)(x) & U64_CONST(0x000000ff00000000)) >>  8) | \
+          (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \
+          (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \
+          (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) ))
+# endif
+
+/*----------------------------------------------------------------------------*/
+# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678  /*     little-endian     */
+/*----------------------------------------------------------------------------*/
+#  define my_htole16(x)                (x)
+#  define my_letoh16(x)                (x)
+#  define my_htole32(x)                (x)
+#  define my_letoh32(x)                (x)
+#  define my_htobe16(x)                _swab_16_(x)
+#  define my_betoh16(x)                _swab_16_(x)
+#  define my_htobe32(x)                _swab_32_(x)
+#  define my_betoh32(x)                _swab_32_(x)
+#  ifdef HAS_QUAD
+#   define my_htole64(x)       (x)
+#   define my_letoh64(x)       (x)
+#   define my_htobe64(x)       _swab_64_(x)
+#   define my_betoh64(x)       _swab_64_(x)
+#  endif
+#  define my_htoles(x)         (x)
+#  define my_letohs(x)         (x)
+#  define my_htolei(x)         (x)
+#  define my_letohi(x)         (x)
+#  define my_htolel(x)         (x)
+#  define my_letohl(x)         (x)
+#  if SHORTSIZE == 1
+#   define my_htobes(x)                (x)
+#   define my_betohs(x)                (x)
+#  elif SHORTSIZE == 2
+#   define my_htobes(x)                _swab_16_(x)
+#   define my_betohs(x)                _swab_16_(x)
+#  elif SHORTSIZE == 4
+#   define my_htobes(x)                _swab_32_(x)
+#   define my_betohs(x)                _swab_32_(x)
+#  elif SHORTSIZE == 8
+#   define my_htobes(x)                _swab_64_(x)
+#   define my_betohs(x)                _swab_64_(x)
+#  else
+#   define PERL_NEED_MY_HTOBES
+#   define PERL_NEED_MY_BETOHS
+#  endif
+#  if INTSIZE == 1
+#   define my_htobei(x)                (x)
+#   define my_betohi(x)                (x)
+#  elif INTSIZE == 2
+#   define my_htobei(x)                _swab_16_(x)
+#   define my_betohi(x)                _swab_16_(x)
+#  elif INTSIZE == 4
+#   define my_htobei(x)                _swab_32_(x)
+#   define my_betohi(x)                _swab_32_(x)
+#  elif INTSIZE == 8
+#   define my_htobei(x)                _swab_64_(x)
+#   define my_betohi(x)                _swab_64_(x)
+#  else
+#   define PERL_NEED_MY_HTOBEI
+#   define PERL_NEED_MY_BETOHI
+#  endif
+#  if LONGSIZE == 1
+#   define my_htobel(x)                (x)
+#   define my_betohl(x)                (x)
+#  elif LONGSIZE == 2
+#   define my_htobel(x)                _swab_16_(x)
+#   define my_betohl(x)                _swab_16_(x)
+#  elif LONGSIZE == 4
+#   define my_htobel(x)                _swab_32_(x)
+#   define my_betohl(x)                _swab_32_(x)
+#  elif LONGSIZE == 8
+#   define my_htobel(x)                _swab_64_(x)
+#   define my_betohl(x)                _swab_64_(x)
+#  else
+#   define PERL_NEED_MY_HTOBEL
+#   define PERL_NEED_MY_BETOHL
+#  endif
+#  define my_htolen(p,n)       NOOP
+#  define my_letohn(p,n)       NOOP
+#  define my_htoben(p,n)       my_swabn(p,n)
+#  define my_betohn(p,n)       my_swabn(p,n)
+/*----------------------------------------------------------------------------*/
+# elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /*     big-endian      */
+/*----------------------------------------------------------------------------*/
+#  define my_htobe16(x)                (x)
+#  define my_betoh16(x)                (x)
+#  define my_htobe32(x)                (x)
+#  define my_betoh32(x)                (x)
+#  define my_htole16(x)                _swab_16_(x)
+#  define my_letoh16(x)                _swab_16_(x)
+#  define my_htole32(x)                _swab_32_(x)
+#  define my_letoh32(x)                _swab_32_(x)
+#  ifdef HAS_QUAD
+#   define my_htobe64(x)       (x)
+#   define my_betoh64(x)       (x)
+#   define my_htole64(x)       _swab_64_(x)
+#   define my_letoh64(x)       _swab_64_(x)
+#  endif
+#  define my_htobes(x)         (x)
+#  define my_betohs(x)         (x)
+#  define my_htobei(x)         (x)
+#  define my_betohi(x)         (x)
+#  define my_htobel(x)         (x)
+#  define my_betohl(x)         (x)
+#  if SHORTSIZE == 1
+#   define my_htoles(x)                (x)
+#   define my_letohs(x)                (x)
+#  elif SHORTSIZE == 2
+#   define my_htoles(x)                _swab_16_(x)
+#   define my_letohs(x)                _swab_16_(x)
+#  elif SHORTSIZE == 4
+#   define my_htoles(x)                _swab_32_(x)
+#   define my_letohs(x)                _swab_32_(x)
+#  elif SHORTSIZE == 8
+#   define my_htoles(x)                _swab_64_(x)
+#   define my_letohs(x)                _swab_64_(x)
+#  else
+#   define PERL_NEED_MY_HTOLES
+#   define PERL_NEED_MY_LETOHS
+#  endif
+#  if INTSIZE == 1
+#   define my_htolei(x)                (x)
+#   define my_letohi(x)                (x)
+#  elif INTSIZE == 2
+#   define my_htolei(x)                _swab_16_(x)
+#   define my_letohi(x)                _swab_16_(x)
+#  elif INTSIZE == 4
+#   define my_htolei(x)                _swab_32_(x)
+#   define my_letohi(x)                _swab_32_(x)
+#  elif INTSIZE == 8
+#   define my_htolei(x)                _swab_64_(x)
+#   define my_letohi(x)                _swab_64_(x)
+#  else
+#   define PERL_NEED_MY_HTOLEI
+#   define PERL_NEED_MY_LETOHI
+#  endif
+#  if LONGSIZE == 1
+#   define my_htolel(x)                (x)
+#   define my_letohl(x)                (x)
+#  elif LONGSIZE == 2
+#   define my_htolel(x)                _swab_16_(x)
+#   define my_letohl(x)                _swab_16_(x)
+#  elif LONGSIZE == 4
+#   define my_htolel(x)                _swab_32_(x)
+#   define my_letohl(x)                _swab_32_(x)
+#  elif LONGSIZE == 8
+#   define my_htolel(x)                _swab_64_(x)
+#   define my_letohl(x)                _swab_64_(x)
+#  else
+#   define PERL_NEED_MY_HTOLEL
+#   define PERL_NEED_MY_LETOHL
+#  endif
+#  define my_htolen(p,n)       my_swabn(p,n)
+#  define my_letohn(p,n)       my_swabn(p,n)
+#  define my_htoben(p,n)       NOOP
+#  define my_betohn(p,n)       NOOP
+/*----------------------------------------------------------------------------*/
+# else /*                       all other byte-orders                         */
+/*----------------------------------------------------------------------------*/
+#  define PERL_NEED_MY_HTOLE16
+#  define PERL_NEED_MY_LETOH16
+#  define PERL_NEED_MY_HTOBE16
+#  define PERL_NEED_MY_BETOH16
+#  define PERL_NEED_MY_HTOLE32
+#  define PERL_NEED_MY_LETOH32
+#  define PERL_NEED_MY_HTOBE32
+#  define PERL_NEED_MY_BETOH32
+#  ifdef HAS_QUAD
+#   define PERL_NEED_MY_HTOLE64
+#   define PERL_NEED_MY_LETOH64
+#   define PERL_NEED_MY_HTOBE64
+#   define PERL_NEED_MY_BETOH64
+#  endif
+#  define PERL_NEED_MY_HTOLES
+#  define PERL_NEED_MY_LETOHS
+#  define PERL_NEED_MY_HTOBES
+#  define PERL_NEED_MY_BETOHS
+#  define PERL_NEED_MY_HTOLEI
+#  define PERL_NEED_MY_LETOHI
+#  define PERL_NEED_MY_HTOBEI
+#  define PERL_NEED_MY_BETOHI
+#  define PERL_NEED_MY_HTOLEL
+#  define PERL_NEED_MY_LETOHL
+#  define PERL_NEED_MY_HTOBEL
+#  define PERL_NEED_MY_BETOHL
+/*----------------------------------------------------------------------------*/
+# endif /*                     end of byte-order macros                       */
+/*----------------------------------------------------------------------------*/
+
+#endif /* PERL_CORE */
+
 /* Cannot include embed.h here on Win32 as win32.h has not 
    yet been included and defines some config variables e.g. HAVE_INTERP_INTERN
  */
@@ -1091,6 +1326,13 @@ typedef UVTYPE UV;
 #  endif
 #endif
 
+#ifndef HAS_QUAD
+# undef PERL_NEED_MY_HTOLE64
+# undef PERL_NEED_MY_LETOH64
+# undef PERL_NEED_MY_HTOBE64
+# undef PERL_NEED_MY_BETOH64
+#endif
+
 #if defined(uts) || defined(UTS)
 #      undef UV_MAX
 #      define UV_MAX (4294967295u)
index 3132242..94fc189 100644 (file)
@@ -54,10 +54,10 @@ L<perlfunc/accept>.
 
 (X) You can't allocate more than 64K on an MS-DOS machine.
 
-=item '!' allowed only after types %s
+=item '%c' allowed only after types %s
 
-(F) The '!' is allowed in pack() or unpack() only after certain types.
-See L<perlfunc/pack>.
+(F) The modifiers '!', '<' and '>' are allowed in pack() or unpack() only
+after certain types.  See L<perlfunc/pack>.
 
 =item Ambiguous call resolved as CORE::%s(), qualify as such or use &
 
@@ -630,6 +630,13 @@ waitpid() without flags is emulated.
 point.  For example, it'd be kind of silly to put a B<-x> on the #!
 line.
 
+=item Can't %s %s-endian %ss on this platform
+
+(F) Your platform's byte-order is neither big-endian nor little-endian,
+or it has a very strange pointer size.  Packing and unpacking big- or
+little-endian floating point values and pointers may not be possible.
+See L<perlfunc/pack>.
+
 =item Can't exec "%s": %s
 
 (W exec) A system(), exec(), or piped open call could not execute the
@@ -1050,6 +1057,12 @@ references are disallowed.  See L<perlref>.
 Errno.pm module. The Errno module is expected to tie the %! hash to
 provide symbolic names for C<$!> errno values.
 
+=item Can't use both '<' and '>' after type '%c' in %s
+
+(F) A type cannot be forced to have both big-endian and little-endian
+byte-order at the same time, so this combination of modifiers is not
+allowed.  See L<perlfunc/pack>.
+
 =item Can't use %s for loop variable
 
 (F) Only a simple scalar variable may be used as a loop variable on a
@@ -1367,6 +1380,11 @@ qualifying it as C<CORE::dump()>.  Maybe it's a typo.  See L<perlfunc/dump>.
 (S malloc) An internal routine called free() on something that had
 already been freed.
 
+=item Duplicate modifier '%c' after '%c' in %s
+
+(W) You have applied the same modifier more than once after a type
+in a pack template.  See L<perlfunc/pack>.
+
 =item elseif should be elsif
 
 (S syntax) There is no keyword "elseif" in Perl because Larry thinks it's
@@ -2892,6 +2910,13 @@ that a method requires a package that has not been loaded.
 recent than the currently running version.  How long has it been since
 you upgraded, anyway?  See L<perlfunc/require>.
 
+=item Perl_my_%s() not available
+
+(F) Your platform has very uncommon byte-order and integer size,
+so it was not possible to set up some or all fixed-width byte-order
+conversion functions.  This is only a problem when you're using the
+'<' or '>' modifiers in (un)pack templates.  See L<perlfunc/pack>.
+
 =item PERL_SH_DIR too long
 
 (F) An error peculiar to OS/2. PERL_SH_DIR is the directory to find the
index 61a5bb5..c7fb1f8 100644 (file)
@@ -3272,38 +3272,14 @@ of values, as follows:
     h  A hex string (low nybble first).
     H  A hex string (high nybble first).
 
-    c  A signed char value.
+    c  A signed char (8-bit) value.
     C  An unsigned char value.  Only does bytes.  See U for Unicode.
 
-    s  A signed short value.
+    s  A signed short (16-bit) value.
     S  An unsigned short value.
-         (This 'short' is _exactly_ 16 bits, which may differ from
-          what a local C compiler calls 'short'.  If you want
-          native-length shorts, use the '!' suffix.)
 
-    i  A signed integer value.
-    I  An unsigned integer value.
-         (This 'integer' is _at_least_ 32 bits wide.  Its exact
-           size depends on what a local C compiler calls 'int',
-           and may even be larger than the 'long' described in
-           the next item.)
-
-    l  A signed long value.
+    l  A signed long (32-bit) value.
     L  An unsigned long value.
-         (This 'long' is _exactly_ 32 bits, which may differ from
-          what a local C compiler calls 'long'.  If you want
-          native-length longs, use the '!' suffix.)
-
-    n  An unsigned short in "network" (big-endian) order.
-    N  An unsigned long in "network" (big-endian) order.
-    v  An unsigned short in "VAX" (little-endian) order.
-    V  An unsigned long in "VAX" (little-endian) order.
-         (These 'shorts' and 'longs' are _exactly_ 16 bits and
-          _exactly_ 32 bits, respectively. If you want signed
-          types instead of unsigned ones, use the '!' suffix.
-          Note that this is _only_ safe if signed integers are
-          stored in the same format on all platforms using the
-          packed data.)
 
     q  A signed quad (64-bit) value.
     Q  An unsigned quad value.
@@ -3311,14 +3287,23 @@ of values, as follows:
           integer values _and_ if Perl has been compiled to support those.
            Causes a fatal error otherwise.)
 
-    j   A signed integer value (a Perl internal integer, IV).
-    J   An unsigned integer value (a Perl internal unsigned integer, UV).
+    i  A signed integer value.
+    I  A unsigned integer value.
+         (This 'integer' is _at_least_ 32 bits wide.  Its exact
+           size depends on what a local C compiler calls 'int'.)
+    n  An unsigned short (16-bit) in "network" (big-endian) order.
+    N  An unsigned long (32-bit) in "network" (big-endian) order.
+    v  An unsigned short (16-bit) in "VAX" (little-endian) order.
+    V  An unsigned long (32-bit) in "VAX" (little-endian) order.
+
+    j   A Perl internal signed integer value (IV).
+    J   A Perl internal unsigned integer value (UV).
 
     f  A single-precision float in the native format.
     d  A double-precision float in the native format.
 
-    F  A floating point value in the native native format
-           (a Perl internal floating point value, NV).
+    F  A Perl internal floating point value (NV) in the native format
     D  A long double-precision float in the native format.
          (Long doubles are available only if your system supports long
           double values _and_ if Perl has been compiled to support those.
@@ -3342,6 +3327,23 @@ of values, as follows:
         the innermost ()-group.
     (  Start of a ()-group.
 
+Some letters in the TEMPLATE may optionally be followed by one or
+more of these modifiers (the second column lists the letters for
+which the modifier is valid):
+
+    !   sSlLiI     Forces native (short, long, int) sizes instead
+                   of fixed (16-/32-bit) sizes.
+
+        xX         Make x and X act as alignment commands.
+
+        nNvV       Treat integers as signed instead of unsigned.
+
+    >   sSiIlLqQ   Force big-endian byte-order on the type.
+        jJfFdDpP   (The "big end" touches the construct.)
+
+    <   sSiIlLqQ   Force little-endian byte-order on the type.
+        jJfFdDpP   (The "little end" touches the construct.)
+
 The following rules apply:
 
 =over 8
@@ -3446,6 +3448,11 @@ The C<P> type packs a pointer to a structure of the size indicated by the
 length.  A NULL pointer is created if the corresponding value for C<p> or
 C<P> is C<undef>, similarly for unpack().
 
+If your system has a strange pointer size (i.e. a pointer is neither as
+big as an int nor as big as a long), it may not be possible to pack or
+unpack pointers in big- or little-endian byte order.  Attempting to do
+so will result in a fatal error.
+
 =item *
 
 The C</> template character allows packing and unpacking of strings where
@@ -3477,7 +3484,7 @@ which Perl does not regard as legal in numeric strings.
 =item *
 
 The integer types C<s>, C<S>, C<l>, and C<L> may be
-immediately followed by a C<!> suffix to signify native shorts or
+followed by a C<!> modifier to signify native shorts or
 longs--as you can see from above for example a bare C<l> does mean
 exactly 32 bits, the native C<long> (as seen by the local C compiler)
 may be larger.  This is an issue mainly in 64-bit platforms.  You can
@@ -3543,12 +3550,39 @@ via L<Config>:
 Byteorders C<'1234'> and C<'12345678'> are little-endian, C<'4321'>
 and C<'87654321'> are big-endian.
 
-If you want portable packed integers use the formats C<n>, C<N>,
-C<v>, and C<V>, their byte endianness and size are known.
+If you want portable packed integers you can either use the formats
+C<n>, C<N>, C<v>, and C<V>, or you can use the C<E<gt>> and C<E<lt>>
+modifiers.  These modifiers are only available as of perl 5.8.5.
 See also L<perlport>.
 
 =item *
 
+All integer and floating point formats as well as C<p> and C<P> may
+be followed by the C<E<gt>> or C<E<lt>> modifiers to force big- or
+little- endian byte-order, respectively.  This is especially useful,
+since C<n>, C<N>, C<v> and C<V> don't cover signed integers, 64-bit
+integers and floating point values.  However, there are some things
+to keep in mind.
+
+Exchanging signed integers between different platforms only works
+if all platforms store them in the same format.  Most platforms store
+signed integers in two's complement, so usually this is not an issue.
+
+The C<E<gt>> or C<E<lt>> modifiers can only be used on floating point
+formats on big- or little-endian machines.  Otherwise, attempting to
+do so will result in a fatal error.
+
+Forcing big- or little-endian byte-order on floating point values for
+data exchange can only work if all platforms are using the same
+binary representation (e.g. IEEE floating point format).  Even if all
+platforms are using IEEE, there may be subtle differences.  Being able
+to use C<E<gt>> or C<E<lt>> on floating point values can be very useful,
+but also very dangerous if you don't know exactly what you're doing.
+It is definetely not a general way to portably store floating point
+values.
+
+=item *
+
 Real numbers (floats and doubles) are in the native machine format only;
 due to the multiplicity of floating formats around, and the lack of a
 standard "network" representation, no facility for interchange has been
@@ -3557,10 +3591,13 @@ may not be readable on another - even if both use IEEE floating point
 arithmetic (as the endian-ness of the memory representation is not part
 of the IEEE spec).  See also L<perlport>.
 
-Note that Perl uses doubles internally for all numeric calculation, and
-converting from double into float and thence back to double again will
-lose precision (i.e., C<unpack("f", pack("f", $foo)>) will not in general
-equal $foo).
+If you know exactly what you're doing, you can use the C<E<gt>> or C<E<lt>>
+modifiers to force big- or little-endian byte-order on floating point values.
+
+Note that Perl uses doubles (or long doubles, if configured) internally for
+all numeric calculation, and converting from double into float and thence back
+to double again will lose precision (i.e., C<unpack("f", pack("f", $foo)>)
+will not in general equal $foo).
 
 =item *
 
@@ -3616,7 +3653,7 @@ using two's complement representation).
 
 A comment in a TEMPLATE starts with C<#> and goes to the end of line.
 White space may be used to separate pack codes from each other, but
-a C<!> modifier and a repeat count must follow immediately.
+modifiers and a repeat count must follow immediately.
 
 =item *
 
@@ -3676,6 +3713,13 @@ Examples:
     # short 12, zero fill to position 4, long 34
     # $foo eq $bar
 
+    $foo = pack('nN', 42, 4711);
+    # pack big-endian 16- and 32-bit unsigned integers
+    $foo = pack('S>L>', 42, 4711);
+    # exactly the same
+    $foo = pack('s<l<', -42, 4711);
+    # pack little-endian 16- and 32-bit signed integers
+
 The same template may generally also be used in unpack().
 
 =item package NAMESPACE
index f78e019..8b8062c 100644 (file)
@@ -224,6 +224,10 @@ them in big-endian mode.  To avoid this problem in network (socket)
 connections use the C<pack> and C<unpack> formats C<n> and C<N>, the
 "network" orders.  These are guaranteed to be portable.
 
+As of perl 5.8.5, you can also use the C<E<gt>> and C<E<lt>> modifiers
+to force big- or little-endian byte-order.  This is useful if you want
+to store signed integers or 64-bit integers, for example.
+
 You can explore the endianness of your platform by unpacking a
 data structure packed in native format such as:
 
index e51a2b9..d484e6a 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -55,16 +55,12 @@ static double UV_MAX_cxux = ((double)UV_MAX);
 /* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
    --jhi Feb 1999 */
 
-#if SHORTSIZE != SIZE16 || LONGSIZE != SIZE32
-#   define PERL_NATINT_PACK
-#endif
-
-#if LONGSIZE > 4 && defined(_CRAY)
-#  if BYTEORDER == 0x12345678
+#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 == 0x87654321
+#    if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /* big-endian */
 #      define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16))
 #      define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32))
 #    else
@@ -135,6 +131,108 @@ S_mul128(pTHX_ SV *sv, U8 m)
 #endif
 
 #define TYPE_IS_SHRIEKING      0x100
+#define TYPE_IS_BIG_ENDIAN     0x200
+#define TYPE_IS_LITTLE_ENDIAN  0x400
+#define TYPE_ENDIANNESS_MASK   (TYPE_IS_BIG_ENDIAN|TYPE_IS_LITTLE_ENDIAN)
+#define TYPE_NO_ENDIANNESS(t)  ((t) & ~TYPE_ENDIANNESS_MASK)
+#define TYPE_NO_MODIFIERS(t)   ((t) & 0xFF)
+
+#define DO_BO_UNPACK(var, type)                                               \
+        STMT_START {                                                          \
+          switch (datumtype & TYPE_ENDIANNESS_MASK) {                         \
+            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 (datumtype & TYPE_ENDIANNESS_MASK) {                         \
+            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 (datumtype & TYPE_ENDIANNESS_MASK) {                         \
+            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 (datumtype & TYPE_ENDIANNESS_MASK) {                         \
+            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 (datumtype & TYPE_ENDIANNESS_MASK) {                        \
+             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 (datumtype & TYPE_ENDIANNESS_MASK) {                        \
+             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 (datumtype & TYPE_ENDIANNESS_MASK) {                        \
+             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
 
 /* Returns the sizeof() struct described by pat */
 STATIC I32
@@ -159,10 +257,11 @@ S_measure_struct(pTHX_ register tempsym_t* symptr)
             break;
         }
 
-       switch(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)symptr->code,
+            Perl_croak(aTHX_ "Invalid type '%c' in %s",
+                       (int)TYPE_NO_MODIFIERS(symptr->code),
                        symptr->flags & FLAG_PACK ? "pack" : "unpack" );
        case '@':
        case '/':
@@ -415,15 +514,44 @@ S_next_symbol(pTHX_ register tempsym_t* symptr )
                      symptr->flags & FLAG_PACK ? "pack" : "unpack" );
       }
 
-      /* test for '!' modifier */
-      if (patptr < patend && *patptr == '!') {
-       static const char natstr[] = "sSiIlLxXnNvV";
-        patptr++;              
-        if (strchr(natstr, code))
-         code |= TYPE_IS_SHRIEKING;
-        else
-         Perl_croak(aTHX_ "'!' allowed only after types %s in %s",
-                     natstr, symptr->flags & FLAG_PACK ? "pack" : "unpack" );
+      /* look for modifiers */
+      while (patptr < patend) {
+        const char *allowed;
+        I32 modifier = 0;
+        switch (*patptr) {
+          case '!':
+            modifier = TYPE_IS_SHRIEKING;
+            allowed = "sSiIlLxXnNvV";
+            break;
+          case '>':
+            modifier = TYPE_IS_BIG_ENDIAN;
+            allowed = "sSiIlLqQjJfFdDpP";
+            break;
+          case '<':
+            modifier = TYPE_IS_LITTLE_ENDIAN;
+            allowed = "sSiIlLqQjJfFdDpP";
+            break;
+          default:
+            break;
+        }
+        if (modifier == 0)
+          break;
+        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" );
+        if ((code | modifier) == (code | TYPE_IS_BIG_ENDIAN | TYPE_IS_LITTLE_ENDIAN))
+          Perl_croak(aTHX_ "Can't use both '<' and '>' after type '%c' in %s",
+                     (int) TYPE_NO_MODIFIERS(code),
+                     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" );
+        }
+        code |= modifier;
+        patptr++;
       }
 
       /* look for count and/or / */ 
@@ -548,7 +676,6 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
     howlen_t howlen;
 
     /* These must not be in registers: */
-    short ashort;
     int aint;
     long along;
 #ifdef HAS_QUAD
@@ -602,9 +729,9 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 
       redo_switch:
         beyond = s >= strend;
-       switch(datumtype) {
+       switch(TYPE_NO_ENDIANNESS(datumtype)) {
        default:
-           Perl_croak(aTHX_ "Invalid type '%c' in unpack", (int)datumtype );
+           Perl_croak(aTHX_ "Invalid type '%c' in unpack", (int)TYPE_NO_MODIFIERS(datumtype) );
 
        case '%':
            if (howlen == e_no_len)
@@ -894,13 +1021,13 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                short ashort;
                while (len-- > 0) {
-                    COPYNN(s, &ashort, sizeof(short));
-                     s += sizeof(short);
-                     if (checksum > bits_in_uv)
-                         cdouble += (NV)ashort;
-                     else
-                         cuv += ashort;
-
+                   COPYNN(s, &ashort, sizeof(short));
+                   DO_BO_UNPACK(ashort, s);
+                   s += sizeof(short);
+                   if (checksum > bits_in_uv)
+                       cdouble += (NV)ashort;
+                   else
+                       cuv += ashort;
                }
            }
            else {
@@ -911,6 +1038,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    COPYNN(s, &ashort, sizeof(short));
+                   DO_BO_UNPACK(ashort, s);
                    s += sizeof(short);
                    sv = NEWSV(38, 0);
                    sv_setiv(sv, (IV)ashort);
@@ -927,16 +1055,17 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                len = along;
            if (checksum) {
                while (len-- > 0) {
-                   COPY16(s, &ashort);
-#if SHORTSIZE > SIZE16
-                   if (ashort > 32767)
-                       ashort -= 65536;
+                   COPY16(s, &asshort);
+                   DO_BO_UNPACK(asshort, 16);
+#if U16SIZE > SIZE16
+                   if (asshort > 32767)
+                       asshort -= 65536;
 #endif
                    s += SIZE16;
                    if (checksum > bits_in_uv)
-                       cdouble += (NV)ashort;
+                       cdouble += (NV)asshort;
                    else
-                       cuv += ashort;
+                       cuv += asshort;
                }
            }
            else {
@@ -946,14 +1075,15 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
 
                while (len-- > 0) {
-                   COPY16(s, &ashort);
-#if SHORTSIZE > SIZE16
-                   if (ashort > 32767)
-                       ashort -= 65536;
+                   COPY16(s, &asshort);
+                   DO_BO_UNPACK(asshort, 16);
+#if U16SIZE > SIZE16
+                   if (asshort > 32767)
+                       asshort -= 65536;
 #endif
                    s += SIZE16;
                    sv = NEWSV(38, 0);
-                   sv_setiv(sv, (IV)ashort);
+                   sv_setiv(sv, (IV)asshort);
                    PUSHs(sv_2mortal(sv));
                }
            }
@@ -967,6 +1097,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                unsigned short aushort;
                while (len-- > 0) {
                    COPYNN(s, &aushort, sizeof(unsigned short));
+                   DO_BO_UNPACK(aushort, s);
                    s += sizeof(unsigned short);
                    if (checksum > bits_in_uv)
                        cdouble += (NV)aushort;
@@ -982,6 +1113,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                while (len-- > 0) {
                    unsigned short aushort;
                    COPYNN(s, &aushort, sizeof(unsigned short));
+                   DO_BO_UNPACK(aushort, s);
                    s += sizeof(unsigned short);
                    sv = NEWSV(39, 0);
                    sv_setiv(sv, (UV)aushort);
@@ -1001,6 +1133,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    COPY16(s, &aushort);
+                   DO_BO_UNPACK(aushort, 16);
                    s += SIZE16;
 #ifdef HAS_NTOHS
                    if (datumtype == 'n')
@@ -1023,6 +1156,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    COPY16(s, &aushort);
+                   DO_BO_UNPACK(aushort, 16);
                    s += SIZE16;
                    sv = NEWSV(39, 0);
 #ifdef HAS_NTOHS
@@ -1091,6 +1225,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &aint, 1, int);
+                   DO_BO_UNPACK(aint, i);
                    s += sizeof(int);
                    if (checksum > bits_in_uv)
                        cdouble += (NV)aint;
@@ -1105,6 +1240,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &aint, 1, int);
+                   DO_BO_UNPACK(aint, i);
                    s += sizeof(int);
                    sv = NEWSV(40, 0);
 #ifdef __osf__
@@ -1145,6 +1281,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &auint, 1, unsigned int);
+                   DO_BO_UNPACK(auint, i);
                    s += sizeof(unsigned int);
                    if (checksum > bits_in_uv)
                        cdouble += (NV)auint;
@@ -1159,6 +1296,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &auint, 1, unsigned int);
+                   DO_BO_UNPACK(auint, i);
                    s += sizeof(unsigned int);
                    sv = NEWSV(41, 0);
 #ifdef __osf__
@@ -1180,6 +1318,13 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &aiv, 1, IV);
+#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);
+#endif
                    s += IVSIZE;
                    if (checksum > bits_in_uv)
                        cdouble += (NV)aiv;
@@ -1194,6 +1339,13 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &aiv, 1, IV);
+#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);
+#endif
                    s += IVSIZE;
                    sv = NEWSV(40, 0);
                    sv_setiv(sv, aiv);
@@ -1208,6 +1360,13 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &auv, 1, UV);
+#if UVSIZE == INTSIZE
+                   DO_BO_UNPACK(auv, i);
+#elif UVSIZE == LONGSIZE
+                   DO_BO_UNPACK(auv, l);
+#elif defined(HAS_QUAD) && UVSIZE == U64SIZE
+                   DO_BO_UNPACK(auv, 64);
+#endif
                    s += UVSIZE;
                    if (checksum > bits_in_uv)
                        cdouble += (NV)auv;
@@ -1222,6 +1381,13 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &auv, 1, UV);
+#if UVSIZE == INTSIZE
+                   DO_BO_UNPACK(auv, i);
+#elif UVSIZE == LONGSIZE
+                   DO_BO_UNPACK(auv, l);
+#elif defined(HAS_QUAD) && UVSIZE == U64SIZE
+                   DO_BO_UNPACK(auv, 64);
+#endif
                    s += UVSIZE;
                    sv = NEWSV(41, 0);
                    sv_setuv(sv, auv);
@@ -1237,6 +1403,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    COPYNN(s, &along, sizeof(long));
+                   DO_BO_UNPACK(along, l);
                    s += sizeof(long);
                    if (checksum > bits_in_uv)
                        cdouble += (NV)along;
@@ -1251,6 +1418,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    COPYNN(s, &along, sizeof(long));
+                   DO_BO_UNPACK(along, l);
                    s += sizeof(long);
                    sv = NEWSV(42, 0);
                    sv_setiv(sv, (IV)along);
@@ -1271,6 +1439,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                    I32 along;
 #endif
                    COPY32(s, &along);
+                   DO_BO_UNPACK(along, 32);
 #if LONGSIZE > SIZE32
                    if (along > 2147483647)
                        along -= 4294967296;
@@ -1292,6 +1461,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                    I32 along;
 #endif
                    COPY32(s, &along);
+                   DO_BO_UNPACK(along, 32);
 #if LONGSIZE > SIZE32
                    if (along > 2147483647)
                        along -= 4294967296;
@@ -1312,6 +1482,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                while (len-- > 0) {
                    unsigned long aulong;
                    COPYNN(s, &aulong, sizeof(unsigned long));
+                   DO_BO_UNPACK(aulong, l);
                    s += sizeof(unsigned long);
                    if (checksum > bits_in_uv)
                        cdouble += (NV)aulong;
@@ -1327,6 +1498,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                while (len-- > 0) {
                    unsigned long aulong;
                    COPYNN(s, &aulong, sizeof(unsigned long));
+                   DO_BO_UNPACK(aulong, l);
                    s += sizeof(unsigned long);
                    sv = NEWSV(43, 0);
                    sv_setuv(sv, (UV)aulong);
@@ -1346,6 +1518,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    COPY32(s, &aulong);
+                   DO_BO_UNPACK(aulong, 32);
                    s += SIZE32;
 #ifdef HAS_NTOHL
                    if (datumtype == 'N')
@@ -1368,6 +1541,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    COPY32(s, &aulong);
+                   DO_BO_UNPACK(aulong, 32);
                    s += SIZE32;
 #ifdef HAS_NTOHL
                    if (datumtype == 'N')
@@ -1439,6 +1613,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                    break;
                else {
                    Copy(s, &aptr, 1, char*);
+                   DO_BO_UNPACK_P(aptr);
                    s += sizeof(char*);
                }
                sv = NEWSV(44, 0);
@@ -1500,6 +1675,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                break;
            else {
                Copy(s, &aptr, 1, char*);
+               DO_BO_UNPACK_P(aptr);
                s += sizeof(char*);
            }
            sv = NEWSV(44, 0);
@@ -1515,6 +1691,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &aquad, 1, Quad_t);
+                   DO_BO_UNPACK(aquad, 64);
                    s += sizeof(Quad_t);
                    if (checksum > bits_in_uv)
                        cdouble += (NV)aquad;
@@ -1532,6 +1709,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                         aquad = 0;
                     else {
                        Copy(s, &aquad, 1, Quad_t);
+                       DO_BO_UNPACK(aquad, 64);
                        s += sizeof(Quad_t);
                     }
                     sv = NEWSV(42, 0);
@@ -1550,6 +1728,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &auquad, 1, Uquad_t);
+                   DO_BO_UNPACK(auquad, 64);
                    s += sizeof(Uquad_t);
                    if (checksum > bits_in_uv)
                        cdouble += (NV)auquad;
@@ -1567,6 +1746,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                         auquad = 0;
                     else {
                         Copy(s, &auquad, 1, Uquad_t);
+                       DO_BO_UNPACK(auquad, 64);
                         s += sizeof(Uquad_t);
                     }
                     sv = NEWSV(43, 0);
@@ -1587,6 +1767,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &afloat, 1, float);
+                   DO_BO_UNPACK_N(afloat, float);
                    s += sizeof(float);
                    cdouble += afloat;
                }
@@ -1598,6 +1779,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &afloat, 1, float);
+                   DO_BO_UNPACK_N(afloat, float);
                    s += sizeof(float);
                    sv = NEWSV(47, 0);
                    sv_setnv(sv, (NV)afloat);
@@ -1612,6 +1794,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &adouble, 1, double);
+                   DO_BO_UNPACK_N(adouble, double);
                    s += sizeof(double);
                    cdouble += adouble;
                }
@@ -1623,6 +1806,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &adouble, 1, double);
+                   DO_BO_UNPACK_N(adouble, double);
                    s += sizeof(double);
                    sv = NEWSV(48, 0);
                    sv_setnv(sv, (NV)adouble);
@@ -1637,6 +1821,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &anv, 1, NV);
+                   DO_BO_UNPACK_N(anv, NV);
                    s += NVSIZE;
                    cdouble += anv;
                }
@@ -1648,6 +1833,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &anv, 1, NV);
+                   DO_BO_UNPACK_N(anv, NV);
                    s += NVSIZE;
                    sv = NEWSV(48, 0);
                    sv_setnv(sv, anv);
@@ -1663,6 +1849,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
            if (checksum) {
                while (len-- > 0) {
                    Copy(s, &aldouble, 1, long double);
+                   DO_BO_UNPACK_N(aldouble, long double);
                    s += LONG_DOUBLESIZE;
                    cdouble += aldouble;
                }
@@ -1674,6 +1861,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                EXTEND_MORTAL(len);
                while (len-- > 0) {
                    Copy(s, &aldouble, 1, long double);
+                   DO_BO_UNPACK_N(aldouble, long double);
                    s += LONG_DOUBLESIZE;
                    sv = NEWSV(48, 0);
                    sv_setnv(sv, (NV)aldouble);
@@ -1745,9 +1933,9 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 
        if (checksum) {
            sv = NEWSV(42, 0);
-           if (strchr("fFdD", datumtype) ||
+           if (strchr("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
              (checksum > bits_in_uv &&
-              strchr("csSiIlLnNUvVqQjJ", datumtype&0xFF)) ) {
+              strchr("csSiIlLnNUvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
                NV trouble;
 
                 adouble = (NV) (1 << (checksum & 15));
@@ -2036,7 +2224,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            len = symptr->length;
            break;
         case e_star:
-           len = strchr("@Xxu", datumtype) ? 0 : items; 
+           len = strchr("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ? 0 : items; 
            break;
         }
 
@@ -2056,9 +2244,9 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
             }
        }
 
-       switch(datumtype) {
+       switch(TYPE_NO_ENDIANNESS(datumtype)) {
        default:
-           Perl_croak(aTHX_ "Invalid type '%c' in pack", (int)datumtype);
+           Perl_croak(aTHX_ "Invalid type '%c' in pack", (int)TYPE_NO_MODIFIERS(datumtype));
        case '%':
            Perl_croak(aTHX_ "'%%' may not be used in pack");
        case '@':
@@ -2264,7 +2452,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
        case 'c':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               switch (datumtype) {
+               switch (TYPE_NO_MODIFIERS(datumtype)) {
                case 'C':
                    aint = SvIV(fromstr);
                    if ((aint < 0 || aint > 255) &&
@@ -2330,6 +2518,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                afloat = (float)SvNV(fromstr);
 # endif
 #endif
+               DO_BO_PACK_N(afloat, float);
                sv_catpvn(cat, (char *)&afloat, sizeof (float));
            }
            break;
@@ -2362,21 +2551,27 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                adouble = (double)SvNV(fromstr);
 # endif
 #endif
+               DO_BO_PACK_N(adouble, double);
                sv_catpvn(cat, (char *)&adouble, sizeof (double));
            }
            break;
        case 'F':
+           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);
                sv_catpvn(cat, (char *)&anv, NVSIZE);
            }
            break;
 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
        case 'D':
+           /* 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);
                sv_catpvn(cat, (char *)&aldouble, LONG_DOUBLESIZE);
            }
            break;
@@ -2411,6 +2606,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    aushort = SvUV(fromstr);
+                   DO_BO_PACK(aushort, s);
                    sv_catpvn(cat, (char *)&aushort, sizeof(unsigned short));
                }
             }
@@ -2425,6 +2621,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    aushort = (U16)SvUV(fromstr);
+                   DO_BO_PACK(aushort, 16);
                    CAT16(cat, &aushort);
                }
 
@@ -2438,6 +2635,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    ashort = SvIV(fromstr);
+                   DO_BO_PACK(ashort, s);
                    sv_catpvn(cat, (char *)&ashort, sizeof(short));
                }
            }
@@ -2449,6 +2647,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            while (len-- > 0) {
                fromstr = NEXTFROM;
                ashort = (I16)SvIV(fromstr);
+               DO_BO_PACK(ashort, 16);
                CAT16(cat, &ashort);
            }
            break;
@@ -2457,6 +2656,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            while (len-- > 0) {
                fromstr = NEXTFROM;
                auint = SvUV(fromstr);
+               DO_BO_PACK(auint, i);
                sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
            }
            break;
@@ -2464,6 +2664,13 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            while (len-- > 0) {
                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);
+#endif
                sv_catpvn(cat, (char*)&aiv, IVSIZE);
            }
            break;
@@ -2471,6 +2678,13 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            while (len-- > 0) {
                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);
+#endif
                sv_catpvn(cat, (char*)&auv, UVSIZE);
            }
            break;
@@ -2580,6 +2794,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            while (len-- > 0) {
                fromstr = NEXTFROM;
                aint = SvIV(fromstr);
+               DO_BO_PACK(aint, i);
                sv_catpvn(cat, (char*)&aint, sizeof(int));
            }
            break;
@@ -2613,6 +2828,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    aulong = SvUV(fromstr);
+                   DO_BO_PACK(aulong, l);
                    sv_catpvn(cat, (char *)&aulong, sizeof(unsigned long));
                }
            }
@@ -2625,6 +2841,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    aulong = SvUV(fromstr);
+                   DO_BO_PACK(aulong, 32);
                    CAT32(cat, &aulong);
                }
            }
@@ -2637,6 +2854,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    along = SvIV(fromstr);
+                   DO_BO_PACK(along, l);
                    sv_catpvn(cat, (char *)&along, sizeof(long));
                }
            }
@@ -2648,6 +2866,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
             while (len-- > 0) {
                fromstr = NEXTFROM;
                along = SvIV(fromstr);
+               DO_BO_PACK(along, 32);
                CAT32(cat, &along);
            }
            break;
@@ -2656,6 +2875,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            while (len-- > 0) {
                fromstr = NEXTFROM;
                auquad = (Uquad_t)SvUV(fromstr);
+               DO_BO_PACK(auquad, 64);
                sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
            }
            break;
@@ -2663,6 +2883,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            while (len-- > 0) {
                fromstr = NEXTFROM;
                aquad = (Quad_t)SvIV(fromstr);
+               DO_BO_PACK(aquad, 64);
                sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
            }
            break;
@@ -2694,6 +2915,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                    else
                        aptr = SvPV_force(fromstr,n_a);
                }
+               DO_BO_PACK_P(aptr);
                sv_catpvn(cat, (char*)&aptr, sizeof(char*));
            }
            break;
diff --git a/proto.h b/proto.h
index 86b32a0..b72fede 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1345,4 +1345,80 @@ PERL_CALLCONV void       Perl_hv_clear_placeholders(pTHX_ HV* hb);
 PERL_CALLCONV SV*      Perl_hv_scalar(pTHX_ HV* hv);
 PERL_CALLCONV SV*      Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC*      mg);
 
+#ifdef PERL_NEED_MY_HTOLE16
+PERL_CALLCONV U16      Perl_my_htole16(U16 n);
+#endif
+#ifdef PERL_NEED_MY_LETOH16
+PERL_CALLCONV U16      Perl_my_letoh16(U16 n);
+#endif
+#ifdef PERL_NEED_MY_HTOBE16
+PERL_CALLCONV U16      Perl_my_htobe16(U16 n);
+#endif
+#ifdef PERL_NEED_MY_BETOH16
+PERL_CALLCONV U16      Perl_my_betoh16(U16 n);
+#endif
+#ifdef PERL_NEED_MY_HTOLE32
+PERL_CALLCONV U32      Perl_my_htole32(U32 n);
+#endif
+#ifdef PERL_NEED_MY_LETOH32
+PERL_CALLCONV U32      Perl_my_letoh32(U32 n);
+#endif
+#ifdef PERL_NEED_MY_HTOBE32
+PERL_CALLCONV U32      Perl_my_htobe32(U32 n);
+#endif
+#ifdef PERL_NEED_MY_BETOH32
+PERL_CALLCONV U32      Perl_my_betoh32(U32 n);
+#endif
+#ifdef PERL_NEED_MY_HTOLE64
+PERL_CALLCONV U64      Perl_my_htole64(U64 n);
+#endif
+#ifdef PERL_NEED_MY_LETOH64
+PERL_CALLCONV U64      Perl_my_letoh64(U64 n);
+#endif
+#ifdef PERL_NEED_MY_HTOBE64
+PERL_CALLCONV U64      Perl_my_htobe64(U64 n);
+#endif
+#ifdef PERL_NEED_MY_BETOH64
+PERL_CALLCONV U64      Perl_my_betoh64(U64 n);
+#endif
+
+#ifdef PERL_NEED_MY_HTOLES
+PERL_CALLCONV short    Perl_my_htoles(short n);
+#endif
+#ifdef PERL_NEED_MY_LETOHS
+PERL_CALLCONV short    Perl_my_letohs(short n);
+#endif
+#ifdef PERL_NEED_MY_HTOBES
+PERL_CALLCONV short    Perl_my_htobes(short n);
+#endif
+#ifdef PERL_NEED_MY_BETOHS
+PERL_CALLCONV short    Perl_my_betohs(short n);
+#endif
+#ifdef PERL_NEED_MY_HTOLEI
+PERL_CALLCONV int      Perl_my_htolei(int n);
+#endif
+#ifdef PERL_NEED_MY_LETOHI
+PERL_CALLCONV int      Perl_my_letohi(int n);
+#endif
+#ifdef PERL_NEED_MY_HTOBEI
+PERL_CALLCONV int      Perl_my_htobei(int n);
+#endif
+#ifdef PERL_NEED_MY_BETOHI
+PERL_CALLCONV int      Perl_my_betohi(int n);
+#endif
+#ifdef PERL_NEED_MY_HTOLEL
+PERL_CALLCONV long     Perl_my_htolel(long n);
+#endif
+#ifdef PERL_NEED_MY_LETOHL
+PERL_CALLCONV long     Perl_my_letohl(long n);
+#endif
+#ifdef PERL_NEED_MY_HTOBEL
+PERL_CALLCONV long     Perl_my_htobel(long n);
+#endif
+#ifdef PERL_NEED_MY_BETOHL
+PERL_CALLCONV long     Perl_my_betohl(long n);
+#endif
+
+PERL_CALLCONV void     Perl_my_swabn(void* ptr, int n);
+
 END_EXTERN_C
index a4c8e91..d7a4137 100755 (executable)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 6076;
+plan tests => 13576;
 
 use strict;
 use warnings;
@@ -14,6 +14,41 @@ use Config;
 
 my $Is_EBCDIC = (defined $Config{ebcdic} && $Config{ebcdic} eq 'define');
 my $Perl = which_perl();
+my @valid_errors = (qr/^Invalid type '\w'/);
+
+my $ByteOrder = 'unknown';
+my $maybe_not_avail = '(?:hto[bl]e|[bl]etoh)';
+if ($Config{byteorder} =~ /^1234(?:5678)?$/) {
+  $ByteOrder = 'little';
+  $maybe_not_avail = '(?:htobe|betoh)';
+}
+elsif ($Config{byteorder} =~ /^(?:8765)?4321$/) {
+  $ByteOrder = 'big';
+  $maybe_not_avail = '(?:htole|letoh)';
+}
+else {
+  push @valid_errors, qr/^Can't (?:un)?pack (?:big|little)-endian .*? on this platform/;
+}
+
+for my $size ( 16, 32, 64 ) {
+  if (exists $Config{"u${size}size"} and $Config{"u${size}size"} != ($size >> 3)) {
+    push @valid_errors, qr/^Perl_my_$maybe_not_avail$size\(\) not available/;
+  }
+}
+
+my $IsTwosComplement = pack('i', -1) eq "\xFF" x $Config{intsize};
+print "# \$IsTwosComplement = $IsTwosComplement\n";
+
+sub is_valid_error
+{
+  my $err = shift;
+
+  for my $e (@valid_errors) {
+    $err =~ $e and return 1;
+  }
+
+  return 0;
+}
 
 sub encode_list {
   my @result = map {_qq($_)} @_;
@@ -177,6 +212,22 @@ sub list_eq ($$) {
   eval { $x = pack 'w', '1'x(1 + length ~0) . 'e0' };
   like ($@, qr/^Can only compress unsigned integers/);
 
+  for my $mod (qw( ! < > )) {
+    eval { $x = pack "a$mod", 42 };
+    like ($@, qr/^'$mod' allowed only after types \w+ in pack/);
+
+    eval { $x = unpack "a$mod", 'x'x8 };
+    like ($@, qr/^'$mod' allowed only after types \w+ in unpack/);
+  }
+
+  for my $mod (qw( <> >< !<> !>< <!> >!< <>! ><! )) {
+    eval { $x = pack "sI${mod}s", 42, 47, 11 };
+    like ($@, qr/^Can't use both '<' and '>' after type 'I' in pack/);
+
+    eval { $x = unpack "sI${mod}s", 'x'x16 };
+    like ($@, qr/^Can't use both '<' and '>' after type 'I' in unpack/);
+  }
+
  SKIP: {
     # Is this a stupid thing to do on VMS, VOS and other unusual platforms?
 
@@ -192,7 +243,7 @@ sub list_eq ($$) {
           ($^O =~ /^svr4/ && -f "/etc/issue" && -f "/etc/.relid") # NCR MP-RAS
           );
 
-    my $inf = eval '2**10000';
+    my $inf = eval '2**1000000';
 
     skip("Couldn't generate infinity - got error '$@'", 1)
       unless defined $inf and $inf == $inf / 2 and $inf + 1 == $inf;
@@ -229,7 +280,7 @@ sub list_eq ($$) {
     # I'm getting about 1e-16 on FreeBSD
     my $quotient = int (100 * ($y - $big) / $big);
     ok($quotient < 2 && $quotient > -2,
-       "Round trip pack, unpack 'w' of $big is withing 1% ($quotient%)");
+       "Round trip pack, unpack 'w' of $big is within 1% ($quotient%)");
   }
 
 }
@@ -238,9 +289,13 @@ print "# test the 'p' template\n";
 
 # literals
 is(unpack("p",pack("p","foo")), "foo");
+is(unpack("p<",pack("p<","foo")), "foo");
+is(unpack("p>",pack("p>","foo")), "foo");
 
 # scalars
 is(unpack("p",pack("p",239)), 239);
+is(unpack("p<",pack("p<",239)), 239);
+is(unpack("p>",pack("p>",239)), 239);
 
 # temps
 sub foo { my $a = "a"; return $a . $a++ . $a++ }
@@ -256,24 +311,36 @@ sub foo { my $a = "a"; return $a . $a++ . $a++ }
 }
 
 # undef should give null pointer
-like(pack("p", undef), qr/^\0+/);
+like(pack("p", undef), qr/^\0+$/);
+like(pack("p<", undef), qr/^\0+$/);
+like(pack("p>", undef), qr/^\0+$/);
 
 # Check for optimizer bug (e.g.  Digital Unix GEM cc with -O4 on DU V4.0B gives
 #                                4294967295 instead of -1)
 #                               see #ifdef __osf__ in pp.c pp_unpack
 is((unpack("i",pack("i",-1))), -1);
 
-print "# test the pack lengths of s S i I l L n N v V\n";
-
-my @lengths = qw(s 2 S 2 i -4 I -4 l 4 L 4 n 2 N 4 v 2 V 4);
-while (my ($format, $expect) = splice @lengths, 0, 2) {
-  my $len = length(pack($format, 0));
-  if ($expect > 0) {
-    is($expect, $len, "format '$format'");
-  } else {
-    $expect = -$expect;
-    ok ($len >= $expect, "format '$format'") ||
-      print "# format '$format' has length $len, expected >= $expect\n";
+print "# test the pack lengths of s S i I l L n N v V + modifiers\n";
+
+my @lengths = (
+  qw(s 2 S 2 i -4 I -4 l 4 L 4 n 2 N 4 v 2 V 4 n! 2 N! 4 v! 2 V! 4),
+  's!'  => $Config{shortsize}, 'S!'  => $Config{shortsize},
+  'i!'  => $Config{intsize},   'I!'  => $Config{intsize},
+  'l!'  => $Config{longsize},  'L!'  => $Config{longsize},
+);
+
+while (my ($base, $expect) = splice @lengths, 0, 2) {
+  my @formats = ($base);
+  $base =~ /^[nv]/i or push @formats, "$base>", "$base<";
+  for my $format (@formats) {
+    my $len = length(pack($format, 0));
+    if ($expect > 0) {
+      is($expect, $len, "format '$format'");
+    } else {
+      $expect = -$expect;
+      ok ($len >= $expect, "format '$format'") ||
+        print "# format '$format' has length $len, expected >= $expect\n";
+    }
   }
 }
 
@@ -282,18 +349,18 @@ print "# test unpack-pack lengths\n";
 
 my @templates = qw(c C i I s S l L n N v V f d q Q);
 
-foreach my $t (@templates) {
-    SKIP: {
-        my @t = eval { unpack("$t*", pack("$t*", 12, 34)) };
-
-        # quads not supported everywhere
-        skip "Quads not supported", 4 if $@ =~ /Invalid type/;
-        is( $@, '' );
+foreach my $base (@templates) {
+    my @tmpl = ($base);
+    $base =~ /^[cnv]/i or push @tmpl, "$base>", "$base<";
+    foreach my $t (@tmpl) {
+        SKIP: {
+            my @t = eval { unpack("$t*", pack("$t*", 12, 34)) };
 
-        is(scalar @t, 2);
+            skip "cannot pack '$t' on this perl", 4
+              if is_valid_error($@);
 
-        SKIP: {
-            skip "$t not expected to work for some reason", 2 if $t =~ /[nv]/i;
+            is( $@, '' );
+            is(scalar @t, 2);
 
             is($t[0], 12);
             is($t[1], 34);
@@ -386,8 +453,12 @@ ok(length(pack("i!", 0)) <= length(pack("l!", 0)));
 is(length(pack("i!", 0)), length(pack("i", 0)));
 
 sub numbers {
-  my $format = shift;
-  return numbers_with_total ($format, undef, @_);
+  my $base = shift;
+  my @formats = ($base);
+  $base =~ /^[silqjfdp]/i and push @formats, "$base>", "$base<";
+  for my $format (@formats) {
+    numbers_with_total ($format, undef, @_);
+  }
 }
 
 sub numbers_with_total {
@@ -402,8 +473,8 @@ sub numbers_with_total {
   foreach (@_) {
     SKIP: {
         my $out = eval {unpack($format, pack($format, $_))};
-        skip "cannot pack '$format' on this perl", 2 if
-          $@ =~ /Invalid type '$format'/;
+        skip "cannot pack '$format' on this perl", 2
+          if is_valid_error($@);
 
         is($@, '');
         is($out, $_);
@@ -423,7 +494,7 @@ sub numbers_with_total {
     SKIP: {
       my $sum = eval {unpack "%$_$format*", pack "$format*", @_};
       skip "cannot pack '$format' on this perl", 3
-        if $@ =~ /Invalid type '$format'/;
+        if is_valid_error($@);
 
       is($@, '');
       ok(defined $sum);
@@ -548,6 +619,117 @@ is(pack("v!", 0xdead), "\xad\xde");
 is(pack("N!", 0xdeadbeef), "\xde\xad\xbe\xef");
 is(pack("V!", 0xdeadbeef), "\xef\xbe\xad\xde");
 
+print "# test big-/little-endian conversion\n";
+
+sub byteorder
+{
+  my $format = shift;
+  print "# byteorder test for $format\n";
+  for my $value (@_) {
+    SKIP: {
+      my($nat,$be,$le) = eval { map { pack $format.$_, $value } '', '>', '<' };
+      skip "cannot pack '$format' on this perl", 5
+        if is_valid_error($@);
+
+      print "# [$value][$nat][$be][$le][$@]\n";
+
+      SKIP: {
+        skip "cannot compare native byteorder with big-/little-endian", 1
+            if $ByteOrder eq 'unknown';
+
+        is($nat, $ByteOrder eq 'big' ? $be : $le);
+      }
+      is($be, reverse($le));
+      my @x = eval { unpack "$format$format>$format<", $nat.$be.$le };
+
+      print "# [$value][", join('][', @x), "][$@]\n";
+
+      is($@, '');
+      is($x[0], $x[1]);
+      is($x[0], $x[2]);
+    }
+  }
+}
+
+byteorder('s', -32768, -1, 0, 1, 32767);
+byteorder('S', 0, 1, 32767, 32768, 65535);
+byteorder('i', -2147483648, -1, 0, 1, 2147483647);
+byteorder('I', 0, 1, 2147483647, 2147483648, 4294967295);
+byteorder('l', -2147483648, -1, 0, 1, 2147483647);
+byteorder('L', 0, 1, 2147483647, 2147483648, 4294967295);
+byteorder('j', -2147483648, -1, 0, 1, 2147483647);
+byteorder('J', 0, 1, 2147483647, 2147483648, 4294967295);
+byteorder('s!', -32768, -1, 0, 1, 32767);
+byteorder('S!', 0, 1, 32767, 32768, 65535);
+byteorder('i!', -2147483648, -1, 0, 1, 2147483647);
+byteorder('I!', 0, 1, 2147483647, 2147483648, 4294967295);
+byteorder('l!', -2147483648, -1, 0, 1, 2147483647);
+byteorder('L!', 0, 1, 2147483647, 2147483648, 4294967295);
+byteorder('q', -9223372036854775808, -1, 0, 1, 9223372036854775807);
+byteorder('Q', 0, 1, 9223372036854775807, 9223372036854775808, 18446744073709551615);
+byteorder('f', -1, 0, 0.5, 42, 2**34);
+byteorder('F', -1, 0, 0.5, 42, 2**34);
+byteorder('d', -(2**34), -1, 0, 1, 2**34);
+byteorder('D', -(2**34), -1, 0, 1, 2**34);
+
+print "# test negative numbers\n";
+
+SKIP: {
+  skip "platform is not using two's complement for negative integers", 120
+    unless $IsTwosComplement;
+
+  for my $format (qw(s i l j s! i! l! q)) {
+    SKIP: {
+      my($nat,$be,$le) = eval { map { pack $format.$_, -1 } '', '>', '<' };
+      skip "cannot pack '$format' on this perl", 15
+        if is_valid_error($@);
+
+      my $len = length $nat;
+      is($_, "\xFF"x$len) for $nat, $be, $le;
+
+      my(@val,@ref);
+      if ($len >= 8) {
+        @val = (-2, -81985529216486896, -9223372036854775808);
+        @ref = ("\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFE",
+                "\xFE\xDC\xBA\x98\x76\x54\x32\x10",
+                "\x80\x00\x00\x00\x00\x00\x00\x00");
+      }
+      elsif ($len >= 4) {
+        @val = (-2, -19088744, -2147483648);
+        @ref = ("\xFF\xFF\xFF\xFE",
+                "\xFE\xDC\xBA\x98",
+                "\x80\x00\x00\x00");
+      }
+      else {
+        @val = (-2, -292, -32768);
+        @ref = ("\xFF\xFE",
+                "\xFE\xDC",
+                "\x80\x00");
+      }
+      for my $x (@ref) {
+        if ($len > length $x) {
+          $x = $x . "\xFF" x ($len - length $x);
+        }
+      }
+
+      for my $i (0 .. $#val) {
+        my($nat,$be,$le) = eval { map { pack $format.$_, $val[$i] } '', '>', '<' };
+        is($@, '');
+
+        SKIP: {
+          skip "cannot compare native byteorder with big-/little-endian", 1
+              if $ByteOrder eq 'unknown';
+
+          is($nat, $ByteOrder eq 'big' ? $be : $le);
+        }
+
+        is($be, $ref[$i]);
+        is($be, reverse($le));
+      }
+    }
+  }
+}
+
 {
   # /
 
@@ -684,7 +866,7 @@ SKIP: {
     {
         local $SIG{__WARN__} = sub { $@ = "@_" };
         my @null = unpack('U0U', chr(255));
-        like($@, /^Malformed UTF-8 character /);
+        like($@, qr/^Malformed UTF-8 character /);
     }
 }
 
@@ -953,6 +1135,16 @@ foreach (
   eval { my @a = unpack( "C/", "\3" ); };
   like( $@, qr{Code missing after '/'} );
 
+  # modifier warnings
+  @warning = ();
+  $x = pack "I>>s!!", 47, 11;
+  ($x) = unpack "I<<l!>!>", 'x'x20;
+  is(scalar @warning, 5);
+  like($warning[0], qr/Duplicate modifier '>' after 'I' in pack/);
+  like($warning[1], qr/Duplicate modifier '!' after 's' in pack/);
+  like($warning[2], qr/Duplicate modifier '<' after 'I' in unpack/);
+  like($warning[3], qr/Duplicate modifier '!' after 'l' in unpack/);
+  like($warning[4], qr/Duplicate modifier '>' after 'l' in unpack/);
 }
 
 {  # Repeat count [SUBEXPR]
@@ -962,7 +1154,7 @@ foreach (
    if (eval { pack 'q', 1 } ) {
      push @codes, qw(q Q);
    } else {
-     push @codes, qw(c C);     # Keep the count the same
+     push @codes, qw(s S);     # Keep the count the same
    }
    if (eval { pack 'D', 1 } ) {
      push @codes, 'D';
@@ -970,6 +1162,8 @@ foreach (
      push @codes, 'd'; # Keep the count the same
    }
 
+   push @codes, map { /^[silqjfdp]/i ? ("$_<", "$_>") : () } @codes;
+
    my %val;
    @val{@codes} = map { / [Xx]  (?{ undef })
                        | [AZa] (?{ 'something' })
@@ -998,18 +1192,23 @@ foreach (
           $c = $1 if $groupend =~ /(\d+)/;
           my @list2 = (@list1) x $c;
 
-          my $junk1 = "$groupbegin $type$count $groupend";
-          # print "# junk1=$junk1\n";
-          my $p = pack $junk1, @list2;
-          my $half = int( (length $p)/2 );
-          for my $move ('', "X$half", "X!$half", 'x1', 'x!8', "x$half") {
-            my $junk = "$junk1 $move";
-            # print "# junk='$junk', list=(@list2)\n";
-            $p = pack "$junk $end", @list2, @end;
-            my @l = unpack "x[$junk] $end", $p;
-            is(scalar @l, scalar @end);
-            is("@l", "@end", "skipping x[$junk]");
-          }
+           SKIP: {
+            my $junk1 = "$groupbegin $type$count $groupend";
+            # print "# junk1=$junk1\n";
+            my $p = eval { pack $junk1, @list2 };
+             skip "cannot pack '$type' on this perl", 12
+               if is_valid_error($@);
+
+            my $half = int( (length $p)/2 );
+            for my $move ('', "X$half", "X!$half", 'x1', 'x!8', "x$half") {
+              my $junk = "$junk1 $move";
+              # print "# junk='$junk', list=(@list2)\n";
+              $p = pack "$junk $end", @list2, @end;
+              my @l = unpack "x[$junk] $end", $p;
+              is(scalar @l, scalar @end);
+              is("@l", "@end", "skipping x[$junk]");
+            }
+           }
        }
      }
    }
@@ -1072,7 +1271,7 @@ numbers ('F', -(2**34), -1, 0, 1, 2**34);
 SKIP: {
     my $t = eval { unpack("D*", pack("D", 12.34)) };
 
-    skip "Long doubles not in use", 56 if $@ =~ /Invalid type/;
+    skip "Long doubles not in use", 166 if $@ =~ /Invalid type/;
 
     is(length(pack("D", 0)), $Config{longdblsize});
     numbers ('D', -(2**34), -1, 0, 1, 2**34);
diff --git a/util.c b/util.c
index 9c12c12..d145262 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1746,7 +1746,7 @@ Perl_my_ntohl(pTHX_ long l)
  * -DWS
  */
 
-#define HTOV(name,type)                                                \
+#define HTOLE(name,type)                                       \
        type                                                    \
        name (register type n)                                  \
        {                                                       \
@@ -1755,14 +1755,14 @@ Perl_my_ntohl(pTHX_ long l)
                char c[sizeof(type)];                           \
            } u;                                                \
            register I32 i;                                     \
-           register I32 s;                                     \
-           for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
+           register I32 s = 0;                                 \
+           for (i = 0; i < sizeof(u.c); i++, s += 8) {         \
                u.c[i] = (n >> s) & 0xFF;                       \
            }                                                   \
            return u.value;                                     \
        }
 
-#define VTOH(name,type)                                                \
+#define LETOH(name,type)                                       \
        type                                                    \
        name (register type n)                                  \
        {                                                       \
@@ -1771,27 +1771,218 @@ Perl_my_ntohl(pTHX_ long l)
                char c[sizeof(type)];                           \
            } u;                                                \
            register I32 i;                                     \
-           register I32 s;                                     \
+           register I32 s = 0;                                 \
            u.value = n;                                        \
            n = 0;                                              \
-           for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
-               n += (u.c[i] & 0xFF) << s;                      \
+           for (i = 0; i < sizeof(u.c); i++, s += 8) {         \
+               n |= ((type)(u.c[i] & 0xFF)) << s;              \
            }                                                   \
            return n;                                           \
        }
 
+/*
+ * Big-endian byte order functions.
+ */
+
+#define HTOBE(name,type)                                       \
+       type                                                    \
+       name (register type n)                                  \
+       {                                                       \
+           union {                                             \
+               type value;                                     \
+               char c[sizeof(type)];                           \
+           } u;                                                \
+           register I32 i;                                     \
+           register I32 s = 8*(sizeof(u.c)-1);                 \
+           for (i = 0; i < sizeof(u.c); i++, s -= 8) {         \
+               u.c[i] = (n >> s) & 0xFF;                       \
+           }                                                   \
+           return u.value;                                     \
+       }
+
+#define BETOH(name,type)                                       \
+       type                                                    \
+       name (register type n)                                  \
+       {                                                       \
+           union {                                             \
+               type value;                                     \
+               char c[sizeof(type)];                           \
+           } u;                                                \
+           register I32 i;                                     \
+           register I32 s = 8*(sizeof(u.c)-1);                 \
+           u.value = n;                                        \
+           n = 0;                                              \
+           for (i = 0; i < sizeof(u.c); i++, s -= 8) {         \
+               n |= ((type)(u.c[i] & 0xFF)) << s;              \
+           }                                                   \
+           return n;                                           \
+       }
+
+/*
+ * If we just can't do it...
+ */
+
+#define NOT_AVAIL(name,type)                                    \
+        type                                                    \
+        name (register type n)                                  \
+        {                                                       \
+            Perl_croak_nocontext(#name "() not available");     \
+            return n; /* not reached */                         \
+        }
+
+
 #if defined(HAS_HTOVS) && !defined(htovs)
-HTOV(htovs,short)
+HTOLE(htovs,short)
 #endif
 #if defined(HAS_HTOVL) && !defined(htovl)
-HTOV(htovl,long)
+HTOLE(htovl,long)
 #endif
 #if defined(HAS_VTOHS) && !defined(vtohs)
-VTOH(vtohs,short)
+LETOH(vtohs,short)
 #endif
 #if defined(HAS_VTOHL) && !defined(vtohl)
-VTOH(vtohl,long)
+LETOH(vtohl,long)
+#endif
+
+#ifdef PERL_NEED_MY_HTOLE16
+# if U16SIZE == 2
+HTOLE(Perl_my_htole16,U16)
+# else
+NOT_AVAIL(Perl_my_htole16,U16)
+# endif
+#endif
+#ifdef PERL_NEED_MY_LETOH16
+# if U16SIZE == 2
+LETOH(Perl_my_letoh16,U16)
+# else
+NOT_AVAIL(Perl_my_letoh16,U16)
+# endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE16
+# if U16SIZE == 2
+HTOBE(Perl_my_htobe16,U16)
+# else
+NOT_AVAIL(Perl_my_htobe16,U16)
+# endif
+#endif
+#ifdef PERL_NEED_MY_BETOH16
+# if U16SIZE == 2
+BETOH(Perl_my_betoh16,U16)
+# else
+NOT_AVAIL(Perl_my_betoh16,U16)
+# endif
+#endif
+
+#ifdef PERL_NEED_MY_HTOLE32
+# if U32SIZE == 4
+HTOLE(Perl_my_htole32,U32)
+# else
+NOT_AVAIL(Perl_my_htole32,U32)
+# endif
+#endif
+#ifdef PERL_NEED_MY_LETOH32
+# if U32SIZE == 4
+LETOH(Perl_my_letoh32,U32)
+# else
+NOT_AVAIL(Perl_my_letoh32,U32)
+# endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE32
+# if U32SIZE == 4
+HTOBE(Perl_my_htobe32,U32)
+# else
+NOT_AVAIL(Perl_my_htobe32,U32)
+# endif
+#endif
+#ifdef PERL_NEED_MY_BETOH32
+# if U32SIZE == 4
+BETOH(Perl_my_betoh32,U32)
+# else
+NOT_AVAIL(Perl_my_betoh32,U32)
+# endif
+#endif
+
+#ifdef PERL_NEED_MY_HTOLE64
+# if U64SIZE == 8
+HTOLE(Perl_my_htole64,U64)
+# else
+NOT_AVAIL(Perl_my_htole64,U64)
+# endif
+#endif
+#ifdef PERL_NEED_MY_LETOH64
+# if U64SIZE == 8
+LETOH(Perl_my_letoh64,U64)
+# else
+NOT_AVAIL(Perl_my_letoh64,U64)
+# endif
+#endif
+#ifdef PERL_NEED_MY_HTOBE64
+# if U64SIZE == 8
+HTOBE(Perl_my_htobe64,U64)
+# else
+NOT_AVAIL(Perl_my_htobe64,U64)
+# endif
 #endif
+#ifdef PERL_NEED_MY_BETOH64
+# if U64SIZE == 8
+BETOH(Perl_my_betoh64,U64)
+# else
+NOT_AVAIL(Perl_my_betoh64,U64)
+# endif
+#endif
+
+#ifdef PERL_NEED_MY_HTOLES
+HTOLE(Perl_my_htoles,short)
+#endif
+#ifdef PERL_NEED_MY_LETOHS
+LETOH(Perl_my_letohs,short)
+#endif
+#ifdef PERL_NEED_MY_HTOBES
+HTOBE(Perl_my_htobes,short)
+#endif
+#ifdef PERL_NEED_MY_BETOHS
+BETOH(Perl_my_betohs,short)
+#endif
+
+#ifdef PERL_NEED_MY_HTOLEI
+HTOLE(Perl_my_htolei,int)
+#endif
+#ifdef PERL_NEED_MY_LETOHI
+LETOH(Perl_my_letohi,int)
+#endif
+#ifdef PERL_NEED_MY_HTOBEI
+HTOBE(Perl_my_htobei,int)
+#endif
+#ifdef PERL_NEED_MY_BETOHI
+BETOH(Perl_my_betohi,int)
+#endif
+
+#ifdef PERL_NEED_MY_HTOLEL
+HTOLE(Perl_my_htolel,long)
+#endif
+#ifdef PERL_NEED_MY_LETOHL
+LETOH(Perl_my_letohl,long)
+#endif
+#ifdef PERL_NEED_MY_HTOBEL
+HTOBE(Perl_my_htobel,long)
+#endif
+#ifdef PERL_NEED_MY_BETOHL
+BETOH(Perl_my_betohl,long)
+#endif
+
+void
+Perl_my_swabn(void *ptr, int n)
+{
+    register char *s = (char *)ptr;
+    register char *e = s + (n-1);
+    register char tc;
+
+    for (n /= 2; n > 0; s++, e--, n--) {
+      tc = *s;
+      *s = *e;
+      *e = tc;
+    }
+}
 
 PerlIO *
 Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)