+/* type modifiers */
+#define TYPE_IS_SHRIEKING 0x100
+#define TYPE_IS_BIG_ENDIAN 0x200
+#define TYPE_IS_LITTLE_ENDIAN 0x400
+#define TYPE_IS_PACK 0x800
+#define TYPE_ENDIANNESS_MASK (TYPE_IS_BIG_ENDIAN|TYPE_IS_LITTLE_ENDIAN)
+#define TYPE_MODIFIERS(t) ((t) & ~0xFF)
+#define TYPE_NO_MODIFIERS(t) ((t) & 0xFF)
+
+#ifdef PERL_PACK_CAN_SHRIEKSIGN
+# define SHRIEKING_ALLOWED_TYPES "sSiIlLxXnNvV@."
+#else
+# define SHRIEKING_ALLOWED_TYPES "sSiIlLxX"
+#endif
+
+#ifndef PERL_PACK_CAN_BYTEORDER
+/* Put "can't" first because it is shorter */
+# define TYPE_ENDIANNESS(t) 0
+# define TYPE_NO_ENDIANNESS(t) (t)
+
+# define ENDIANNESS_ALLOWED_TYPES ""
+
+# define DO_BO_UNPACK(var, type)
+# define DO_BO_PACK(var, type)
+# define DO_BO_UNPACK_PTR(var, type, pre_cast, post_cast)
+# define DO_BO_PACK_PTR(var, type, pre_cast, post_cast)
+# define DO_BO_UNPACK_N(var, type)
+# define DO_BO_PACK_N(var, type)
+# define DO_BO_UNPACK_P(var)
+# define DO_BO_PACK_P(var)
+# define DO_BO_UNPACK_PC(var)
+# define DO_BO_PACK_PC(var)
+
+#else /* PERL_PACK_CAN_BYTEORDER */
+
+# define TYPE_ENDIANNESS(t) ((t) & TYPE_ENDIANNESS_MASK)
+# define TYPE_NO_ENDIANNESS(t) ((t) & ~TYPE_ENDIANNESS_MASK)
+
+# define ENDIANNESS_ALLOWED_TYPES "sSiIlLqQjJfFdDpP("
+
+# define DO_BO_UNPACK(var, type) \
+ STMT_START { \
+ switch (TYPE_ENDIANNESS(datumtype)) { \
+ case TYPE_IS_BIG_ENDIAN: var = my_betoh ## type (var); break; \
+ case TYPE_IS_LITTLE_ENDIAN: var = my_letoh ## type (var); break; \
+ default: break; \
+ } \
+ } STMT_END
+
+# define DO_BO_PACK(var, type) \
+ STMT_START { \
+ switch (TYPE_ENDIANNESS(datumtype)) { \
+ case TYPE_IS_BIG_ENDIAN: var = my_htobe ## type (var); break; \
+ case TYPE_IS_LITTLE_ENDIAN: var = my_htole ## type (var); break; \
+ default: break; \
+ } \
+ } STMT_END
+
+# define DO_BO_UNPACK_PTR(var, type, pre_cast, post_cast) \
+ STMT_START { \
+ switch (TYPE_ENDIANNESS(datumtype)) { \
+ case TYPE_IS_BIG_ENDIAN: \
+ var = (post_cast*) my_betoh ## type ((pre_cast) var); \
+ break; \
+ case TYPE_IS_LITTLE_ENDIAN: \
+ var = (post_cast *) my_letoh ## type ((pre_cast) var); \
+ break; \
+ default: \
+ break; \
+ } \
+ } STMT_END
+
+# define DO_BO_PACK_PTR(var, type, pre_cast, post_cast) \
+ STMT_START { \
+ switch (TYPE_ENDIANNESS(datumtype)) { \
+ case TYPE_IS_BIG_ENDIAN: \
+ var = (post_cast *) my_htobe ## type ((pre_cast) var); \
+ break; \
+ case TYPE_IS_LITTLE_ENDIAN: \
+ var = (post_cast *) my_htole ## type ((pre_cast) var); \
+ break; \
+ default: \
+ break; \
+ } \
+ } STMT_END
+
+# define BO_CANT_DOIT(action, type) \
+ STMT_START { \
+ switch (TYPE_ENDIANNESS(datumtype)) { \
+ case TYPE_IS_BIG_ENDIAN: \
+ Perl_croak(aTHX_ "Can't %s big-endian %ss on this " \
+ "platform", #action, #type); \
+ break; \
+ case TYPE_IS_LITTLE_ENDIAN: \
+ Perl_croak(aTHX_ "Can't %s little-endian %ss on this " \
+ "platform", #action, #type); \
+ break; \
+ default: \
+ break; \
+ } \
+ } STMT_END
+
+# if PTRSIZE == INTSIZE
+# define DO_BO_UNPACK_P(var) DO_BO_UNPACK_PTR(var, i, int, void)
+# define DO_BO_PACK_P(var) DO_BO_PACK_PTR(var, i, int, void)
+# define DO_BO_UNPACK_PC(var) DO_BO_UNPACK_PTR(var, i, int, char)
+# define DO_BO_PACK_PC(var) DO_BO_PACK_PTR(var, i, int, char)
+# elif PTRSIZE == LONGSIZE
+# 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)
+# define DO_BO_UNPACK_PC(var) DO_BO_UNPACK_PTR(var, l, IV, char)
+# define DO_BO_PACK_PC(var) DO_BO_PACK_PTR(var, l, IV, char)
+# else
+# define DO_BO_UNPACK_P(var) BO_CANT_DOIT(unpack, pointer)
+# define DO_BO_PACK_P(var) BO_CANT_DOIT(pack, pointer)
+# define DO_BO_UNPACK_PC(var) BO_CANT_DOIT(unpack, pointer)
+# define DO_BO_PACK_PC(var) BO_CANT_DOIT(pack, pointer)
+# endif
+
+# if defined(my_htolen) && defined(my_letohn) && \
+ defined(my_htoben) && defined(my_betohn)
+# define DO_BO_UNPACK_N(var, type) \
+ STMT_START { \
+ switch (TYPE_ENDIANNESS(datumtype)) { \
+ case TYPE_IS_BIG_ENDIAN: my_betohn(&var, sizeof(type)); break;\
+ case TYPE_IS_LITTLE_ENDIAN: my_letohn(&var, sizeof(type)); break;\
+ default: break; \
+ } \
+ } STMT_END
+
+# define DO_BO_PACK_N(var, type) \
+ STMT_START { \
+ switch (TYPE_ENDIANNESS(datumtype)) { \
+ case TYPE_IS_BIG_ENDIAN: my_htoben(&var, sizeof(type)); break;\
+ case TYPE_IS_LITTLE_ENDIAN: my_htolen(&var, sizeof(type)); break;\
+ default: break; \
+ } \
+ } STMT_END
+# else
+# define DO_BO_UNPACK_N(var, type) BO_CANT_DOIT(unpack, type)
+# define DO_BO_PACK_N(var, type) BO_CANT_DOIT(pack, type)
+# endif
+
+#endif /* PERL_PACK_CAN_BYTEORDER */
+
+#define PACK_SIZE_CANNOT_CSUM 0x80
+#define PACK_SIZE_UNPREDICTABLE 0x40 /* Not a fixed size element */
+#define PACK_SIZE_MASK 0x3F
+
+/* These tables are regenerated by genpacksizetables.pl (and then hand pasted
+ in). You're unlikely ever to need to regenerate them. */
+
+#if TYPE_IS_SHRIEKING != 0x100
+ ++++shriek offset should be 256
+#endif
+
+typedef U8 packprops_t;
+#if 'J'-'I' == 1
+/* ASCII */
+STATIC const packprops_t packprops[512] = {
+ /* normal */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0,
+ /* C */ sizeof(unsigned char),
+#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+ /* D */ LONG_DOUBLESIZE,
+#else
+ 0,
+#endif
+ 0,
+ /* F */ NVSIZE,
+ 0, 0,
+ /* I */ sizeof(unsigned int),
+ /* J */ UVSIZE,
+ 0,
+ /* L */ SIZE32,
+ 0,
+ /* N */ SIZE32,
+ 0, 0,
+#if defined(HAS_QUAD)
+ /* Q */ sizeof(Uquad_t),
+#else
+ 0,
+#endif
+ 0,
+ /* S */ SIZE16,
+ 0,
+ /* U */ sizeof(char) | PACK_SIZE_UNPREDICTABLE,
+ /* V */ SIZE32,
+ /* W */ sizeof(unsigned char) | PACK_SIZE_UNPREDICTABLE,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* c */ sizeof(char),
+ /* d */ sizeof(double),
+ 0,
+ /* f */ sizeof(float),
+ 0, 0,
+ /* i */ sizeof(int),
+ /* j */ IVSIZE,
+ 0,
+ /* l */ SIZE32,
+ 0,
+ /* n */ SIZE16,
+ 0,
+ /* p */ sizeof(char *) | PACK_SIZE_CANNOT_CSUM,
+#if defined(HAS_QUAD)
+ /* q */ sizeof(Quad_t),
+#else
+ 0,
+#endif
+ 0,
+ /* s */ SIZE16,
+ 0, 0,
+ /* v */ SIZE16,
+ /* w */ sizeof(char) | PACK_SIZE_UNPREDICTABLE | PACK_SIZE_CANNOT_CSUM,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ /* shrieking */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* I */ sizeof(unsigned int),
+ 0, 0,
+ /* L */ sizeof(unsigned long),
+ 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* N */ SIZE32,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0,
+ /* S */ sizeof(unsigned short),
+ 0, 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* V */ SIZE32,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0,
+ /* i */ sizeof(int),
+ 0, 0,
+ /* l */ sizeof(long),
+ 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* n */ SIZE16,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0,
+ /* s */ sizeof(short),
+ 0, 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* v */ SIZE16,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0
+};
+#else
+/* EBCDIC (or bust) */
+STATIC const packprops_t packprops[512] = {
+ /* normal */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0,
+ /* c */ sizeof(char),
+ /* d */ sizeof(double),
+ 0,
+ /* f */ sizeof(float),
+ 0, 0,
+ /* i */ sizeof(int),
+ 0, 0, 0, 0, 0, 0, 0,
+ /* j */ IVSIZE,
+ 0,
+ /* l */ SIZE32,
+ 0,
+ /* n */ SIZE16,
+ 0,
+ /* p */ sizeof(char *) | PACK_SIZE_CANNOT_CSUM,
+#if defined(HAS_QUAD)
+ /* q */ sizeof(Quad_t),
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* s */ SIZE16,
+ 0, 0,
+ /* v */ SIZE16,
+ /* w */ sizeof(char) | PACK_SIZE_UNPREDICTABLE | PACK_SIZE_CANNOT_CSUM,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* C */ sizeof(unsigned char),
+#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+ /* D */ LONG_DOUBLESIZE,
+#else
+ 0,
+#endif
+ 0,
+ /* F */ NVSIZE,
+ 0, 0,
+ /* I */ sizeof(unsigned int),
+ 0, 0, 0, 0, 0, 0, 0,
+ /* J */ UVSIZE,
+ 0,
+ /* L */ SIZE32,
+ 0,
+ /* N */ SIZE32,
+ 0, 0,
+#if defined(HAS_QUAD)
+ /* Q */ sizeof(Uquad_t),
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* S */ SIZE16,
+ 0,
+ /* U */ sizeof(char) | PACK_SIZE_UNPREDICTABLE,
+ /* V */ SIZE32,
+ /* W */ sizeof(unsigned char) | PACK_SIZE_UNPREDICTABLE,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* shrieking */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* i */ sizeof(int),
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* l */ sizeof(long),
+ 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* n */ SIZE16,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* s */ sizeof(short),
+ 0, 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* v */ SIZE16,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0,
+ /* I */ sizeof(unsigned int),
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* L */ sizeof(unsigned long),
+ 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* N */ SIZE32,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ /* S */ sizeof(unsigned short),
+ 0, 0,
+#if defined(PERL_PACK_CAN_SHRIEKSIGN)
+ /* V */ SIZE32,
+#else
+ 0,
+#endif
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
+};
+#endif