pp_pack.c revision 7c478bd95313f5f23a4c958a745db2134aa03244
/* pp_pack.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* He still hopefully carried some of his gear in his pack: a small tinder-box,
* two small shallow pans, the smaller fitting into the larger; inside them a
* wooden spoon, a short two-pronged fork and some skewers were stowed; and
* hidden at the bottom of the pack in a flat wooden box a dwindling treasure,
* some salt.
*/
#include "EXTERN.h"
#define PERL_IN_PP_PACK_C
#include "perl.h"
/*
* seems to show up when compiling pp.c - it generates the wrong double
* precision constant value for (double)UV_MAX when used inline in the body
* of the code below, so this makes a static variable up front (which the
* compiler seems to get correct) and uses it in place of UV_MAX below.
*/
#ifdef CXUX_BROKEN_CONSTANT_CONVERT
static double UV_MAX_cxux = ((double)UV_MAX);
#endif
/*
*
* On architectures where I16 and I32 aren't really 16 and 32 bits,
* which for now are all Crays, pack and unpack have to play games.
*/
/*
* These values are required for portability of pack() output.
* If they're not right on your machine, then pack() and unpack()
* wouldn't work right anyway; you'll need to apply the Cray hack.
* (I'd like to check them with #if, but you can't use sizeof() in
* the preprocessor.) --???
*/
/*
The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
defines are now in config.h. --Andy Dougherty April 1998
*/
#define SIZE16 2
#define SIZE32 4
/* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
--jhi Feb 1999 */
# define PERL_NATINT_PACK
#endif
# if BYTEORDER == 0x12345678
# define OFF16(p) (char*)(p)
# define OFF32(p) (char*)(p)
# else
# if BYTEORDER == 0x87654321
# else
# endif
# endif
#else
#endif
/* Avoid stack overflow due to pathological templates. 100 should be plenty. */
#define MAX_SUB_TEMPLATE_LEVEL 100
/* flags */
#define FLAG_UNPACK_ONLY_ONE 0x10
#define FLAG_UNPACK_DO_UTF8 0x08
#define FLAG_SLASH 0x04
#define FLAG_COMMA 0x02
#define FLAG_PACK 0x01
{
char *t;
U32 i = 0;
}
t = s + len - 1;
while (!*t) /* trailing '\0'? */
t--;
while (t > s) {
i = ((*t - '0') << 7) + m;
*(t--) = '0' + (char)(i % 10);
m = (char)(i / 10);
}
return (sv);
}
/* Explosives and implosives. */
#if 'I' == 73 && 'J' == 74
#else
/*
Some other sort of character set - use memchr() so we don't match
the null byte.
*/
#endif
#define TYPE_IS_SHRIEKING 0x100
/* Returns the sizeof() struct described by pat */
{
int star;
register int size;
while (next_symbol(symptr)) {
case e_no_len:
case e_number:
break;
case e_star:
break;
}
default:
case '@':
case '/':
case 'U': /* XXXX Is it correct? */
case 'w':
case 'u':
case '%':
size = 0;
break;
case '(':
{
/* XXXX Theoretically, we need to measure many times at different
positions, since the subexpression may contain
alignment commands, but be not of aligned length.
Need to detect this and croak(). */
break;
}
case 'X' | TYPE_IS_SHRIEKING:
/* XXXX Is this useful? Then need to treat MEASURE_BACKWARDS. */
if (!len) /* Avoid division by 0 */
len = 1;
/* FALL THROUGH */
case 'X':
size = -1;
break;
case 'x' | TYPE_IS_SHRIEKING:
if (!len) /* Avoid division by 0 */
len = 1;
if (star) /* Other portable ways? */
else
len = 0;
/* FALL THROUGH */
case 'x':
case 'A':
case 'Z':
case 'a':
case 'c':
case 'C':
size = 1;
break;
case 'B':
case 'b':
size = 1;
break;
case 'H':
case 'h':
size = 1;
break;
case 's' | TYPE_IS_SHRIEKING:
size = sizeof(short);
break;
#else
/* FALL THROUGH */
#endif
case 's':
break;
case 'S' | TYPE_IS_SHRIEKING:
size = sizeof(unsigned short);
break;
#else
/* FALL THROUGH */
#endif
case 'v':
case 'n':
case 'S':
break;
case 'i' | TYPE_IS_SHRIEKING:
case 'i':
size = sizeof(int);
break;
case 'I' | TYPE_IS_SHRIEKING:
case 'I':
size = sizeof(unsigned int);
break;
case 'j':
break;
case 'J':
break;
case 'l' | TYPE_IS_SHRIEKING:
size = sizeof(long);
break;
#else
/* FALL THROUGH */
#endif
case 'l':
break;
case 'L' | TYPE_IS_SHRIEKING:
size = sizeof(unsigned long);
break;
#else
/* FALL THROUGH */
#endif
case 'V':
case 'N':
case 'L':
break;
case 'P':
len = 1;
/* FALL THROUGH */
case 'p':
size = sizeof(char*);
break;
#ifdef HAS_QUAD
case 'q':
break;
case 'Q':
break;
#endif
case 'f':
size = sizeof(float);
break;
case 'd':
size = sizeof(double);
break;
case 'F':
break;
#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
case 'D':
break;
#endif
}
}
return total;
}
/* locate matching closing parenthesis or bracket
* returns char pointer to char after match, or NULL
*/
STATIC char *
{
char c = *patptr++;
if (isSPACE(c))
continue;
else if (c == ender)
return patptr-1;
else if (c == '#') {
patptr++;
continue;
} else if (c == '(')
else if (c == '[')
}
ender);
return 0;
}
/* Convert unsigned decimal number to binary.
* Expects a pointer to the first digit and address of length variable
* Advances char pointer to 1st non-digit char and returns number
*/
STATIC char *
{
}
return patptr;
}
/* The marvellous template parsing routine: Using state stored in *symptr,
* locates next template code and count
*/
STATIC bool
{
patptr++;
else if (*patptr == '#') {
patptr++;
patptr++;
patptr++;
} else {
/* We should have found a template code */
"Invalid type ',' in %s",
}
continue;
}
/* for '(', skip to ')' */
if (code == '(') {
}
/* test for '!' modifier */
static const char natstr[] = "sSiIlLxX";
patptr++;
else
}
} else if (*patptr == '*') {
patptr++;
} else if (*patptr == '[') {
/* what kind of [] is it? */
if( *lenptr != ']' )
} else {
}
} else {
}
/* try to find / */
patptr++;
else if (*patptr == '#') {
patptr++;
patptr++;
patptr++;
} else {
if( *patptr == '/' ){
patptr++;
}
break;
}
}
} else {
/* at end - no count, no / */
}
return TRUE;
}
}
return FALSE;
}
/*
=for apidoc unpack_str
The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
and ocnt are not used. This call should not be used, use unpackstring instead.
=cut */
Perl_unpack_str(pTHX_ char *pat, register char *patend, register char *s, char *strbeg, char *strend, char **new_s, I32 ocnt, U32 flags)
{
}
/*
=for apidoc unpackstring
The engine implementing unpack() Perl function. C<unpackstring> puts the
extracted list items on the stack and returns the number of elements.
Issue C<PUTBACK> before and C<SPAGAIN> after the call to this function.
=cut */
Perl_unpackstring(pTHX_ char *pat, register char *patend, register char *s, char *strend, U32 flags)
{
}
S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, char *strend, char **new_s )
{
dSP;
register char *str;
/* These must not be in registers: */
short ashort;
int aint;
long along;
#ifdef HAS_QUAD
#endif
unsigned int auint;
#ifdef HAS_QUAD
#endif
char *aptr;
float afloat;
double adouble;
char* strrelbeg = s;
#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
long double aldouble;
#endif
while (next_symbol(symptr)) {
/* do first one only unless in list context
/ is implemented by unpacking the count, then poping it from the
stack, so must check that we're not in the middle of a / */
if ( unpack_only_one
break;
case e_no_len:
case e_number:
break;
case e_star:
break;
}
switch(datumtype) {
default:
case '%':
cuv = 0;
cdouble = 0;
continue;
break;
case '(':
{
char *ss = s; /* Move from register */
while (len--) {
break; /* No way to continue */
}
s = ss;
break;
}
case '@':
break;
case 'X' | TYPE_IS_SHRIEKING:
if (!len) /* Avoid division by 0 */
len = 1;
/* FALL THROUGH */
case 'X':
s -= len;
break;
case 'x' | TYPE_IS_SHRIEKING:
if (!len) /* Avoid division by 0 */
len = 1;
if (aint) /* Other portable ways? */
else
len = 0;
/* FALL THROUGH */
case 'x':
s += len;
break;
case '/':
break;
case 'A':
case 'Z':
case 'a':
if (checksum)
goto uchar_checksum;
aptr = s; /* borrow register */
while (*s)
s++;
}
else { /* 'A' strips both nulls and spaces */
s--;
*++s = '\0';
}
s = aptr; /* unborrow register */
}
s += len;
break;
case 'B':
case 'b':
if (checksum) {
if (!PL_bitcount) {
}
}
while (len >= 8) {
cuv += PL_bitcount[*(unsigned char*)s++];
len -= 8;
}
if (len) {
bits = *s;
if (datumtype == 'b') {
while (len-- > 0) {
bits >>= 1;
}
}
else {
while (len-- > 0) {
bits <<= 1;
}
}
}
break;
}
if (datumtype == 'b') {
bits >>= 1;
else
bits = *s++;
}
}
else {
if (len & 7)
bits <<= 1;
else
bits = *s++;
}
}
*str = '\0';
break;
case 'H':
case 'h':
if (datumtype == 'h') {
if (len & 1)
bits >>= 4;
else
bits = *s++;
}
}
else {
if (len & 1)
bits <<= 4;
else
bits = *s++;
}
}
*str = '\0';
break;
case 'c':
if (checksum) {
while (len-- > 0) {
aint = *s++;
aint -= 256;
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
aint = *s++;
aint -= 256;
}
}
break;
case 'C':
unpack_C: /* unpack U will jump here if not UTF-8 */
if (len == 0) {
break;
}
if (checksum) {
while (len-- > 0) {
auint = *s++ & 255;
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
auint = *s++ & 255;
}
}
break;
case 'U':
if (len == 0) {
break;
}
goto unpack_C;
if (checksum) {
auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV));
s += along;
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV));
s += along;
}
}
break;
case 's' | TYPE_IS_SHRIEKING:
if (checksum) {
short ashort;
while (len-- > 0) {
s += sizeof(short);
if (checksum > bits_in_uv)
else
}
}
else {
short ashort;
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += sizeof(short);
}
}
break;
#else
/* Fallthrough! */
#endif
case 's':
if (checksum) {
while (len-- > 0) {
if (ashort > 32767)
ashort -= 65536;
#endif
s += SIZE16;
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
if (ashort > 32767)
ashort -= 65536;
#endif
s += SIZE16;
}
}
break;
case 'S' | TYPE_IS_SHRIEKING:
if (checksum) {
unsigned short aushort;
while (len-- > 0) {
s += sizeof(unsigned short);
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
unsigned short aushort;
s += sizeof(unsigned short);
}
}
break;
#else
/* Fallhrough! */
#endif
case 'v':
case 'n':
case 'S':
if (checksum) {
while (len-- > 0) {
s += SIZE16;
#ifdef HAS_NTOHS
if (datumtype == 'n')
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
#endif
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += SIZE16;
#ifdef HAS_NTOHS
if (datumtype == 'n')
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
#endif
}
}
break;
case 'i':
case 'i' | TYPE_IS_SHRIEKING:
if (checksum) {
while (len-- > 0) {
s += sizeof(int);
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += sizeof(int);
#ifdef __osf__
/* Without the dummy below unpack("i", pack("i",-1))
* return 0xFFffFFff instead of -1 for Digital Unix V4.0
* cc with optimization turned on.
*
* The bug was detected in
* DEC C V5.8-009 on Digital UNIX V4.0 (Rev. 1091) (V4.0E)
* with optimization (-O4) turned on.
* DEC C V5.2-040 on Digital UNIX V4.0 (Rev. 564) (V4.0B)
* does not have this problem even with -O4.
*
* This bug was reported as DECC_BUGS 1431
* and tracked internally as GEM_BUGS 7775.
*
* The bug is fixed in
* Tru64 UNIX V5.0: Compaq C V6.1-006 or later
* UNIX V4.0F support: DEC C V5.9-006 or later
* UNIX V4.0E support: DEC C V5.8-011 or later
* and also in DTK.
*
* See also few lines later for the same bug.
*/
(aint) ?
#endif
}
}
break;
case 'I':
case 'I' | TYPE_IS_SHRIEKING:
if (checksum) {
while (len-- > 0) {
s += sizeof(unsigned int);
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += sizeof(unsigned int);
#ifdef __osf__
/* Without the dummy below unpack("I", pack("I",0xFFFFFFFF))
* returns 1.84467440737096e+19 instead of 0xFFFFFFFF.
* See details few lines earlier. */
(auint) ?
#endif
}
}
break;
case 'j':
if (checksum) {
while (len-- > 0) {
s += IVSIZE;
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += IVSIZE;
}
}
break;
case 'J':
if (checksum) {
while (len-- > 0) {
s += UVSIZE;
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += UVSIZE;
}
}
break;
case 'l' | TYPE_IS_SHRIEKING:
if (checksum) {
while (len-- > 0) {
s += sizeof(long);
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += sizeof(long);
}
}
break;
#else
/* Fallthrough! */
#endif
case 'l':
if (checksum) {
while (len-- > 0) {
#endif
if (along > 2147483647)
along -= 4294967296;
#endif
s += SIZE32;
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
#endif
if (along > 2147483647)
along -= 4294967296;
#endif
s += SIZE32;
}
}
break;
case 'L' | TYPE_IS_SHRIEKING:
if (checksum) {
while (len-- > 0) {
unsigned long aulong;
s += sizeof(unsigned long);
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
unsigned long aulong;
s += sizeof(unsigned long);
}
}
break;
#else
/* Fall through! */
#endif
case 'V':
case 'N':
case 'L':
if (checksum) {
while (len-- > 0) {
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
#endif
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
#endif
}
}
break;
case 'p':
while (len-- > 0) {
if (sizeof(char*) > strend - s)
break;
else {
s += sizeof(char*);
}
if (aptr)
}
break;
case 'w':
if (len && unpack_only_one)
len = 1;
{
/* UTF8_IS_XXXXX not right here - using constant 0x80 */
if ((U8)(*s++) < 0x80) {
bytes = 0;
len--;
auv = 0;
}
char *t;
while (s < strend) {
if (!(*s++ & 0x80)) {
bytes = 0;
break;
}
}
while (*t == '0')
t++;
len--;
auv = 0;
}
}
}
break;
case 'P':
if (sizeof(char*) > strend - s)
break;
else {
s += sizeof(char*);
}
if (aptr)
break;
#ifdef HAS_QUAD
case 'q':
if (checksum) {
while (len-- > 0) {
s += sizeof(Quad_t);
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
aquad = 0;
else {
s += sizeof(Quad_t);
}
else
}
}
break;
case 'Q':
if (checksum) {
while (len-- > 0) {
s += sizeof(Uquad_t);
if (checksum > bits_in_uv)
else
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
auquad = 0;
else {
s += sizeof(Uquad_t);
}
else
}
}
break;
#endif
/* float and double added gnb@melba.bby.oz.au 22/11/89 */
case 'f':
if (checksum) {
while (len-- > 0) {
s += sizeof(float);
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += sizeof(float);
}
}
break;
case 'd':
if (checksum) {
while (len-- > 0) {
s += sizeof(double);
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += sizeof(double);
}
}
break;
case 'F':
if (checksum) {
while (len-- > 0) {
s += NVSIZE;
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += NVSIZE;
}
}
break;
#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
case 'D':
if (checksum) {
while (len-- > 0) {
s += LONG_DOUBLESIZE;
}
}
else {
if (len && unpack_only_one)
len = 1;
while (len-- > 0) {
s += LONG_DOUBLESIZE;
}
}
break;
#endif
case 'u':
/* MKS:
* Initialise the decode mapping. By using a table driven
* algorithm, the code will be character-set independent
* (and just as fast as doing character arithmetic)
*/
if (PL_uudmap['M'] == 0) {
int i;
for (i = 0; i < sizeof(PL_uuemap); i += 1)
/*
* Because ' ' and '`' map to the same value,
* we need to decode them both the same.
*/
PL_uudmap[' '] = 0;
}
if (along)
I32 a, b, c, d;
char hunk[4];
while (len > 0) {
else
a = 0;
else
b = 0;
else
c = 0;
else
d = 0;
len -= 3;
}
if (*s == '\n')
s++;
else /* possible checksum byte */
s += 2;
}
break;
}
if (checksum) {
(checksum > bits_in_uv &&
while (checksum >= 16) {
checksum -= 16;
adouble *= 65536.0;
}
while (cdouble < 0.0)
}
else {
if (checksum < bits_in_uv) {
}
}
checksum = 0;
}
if( next_symbol(symptr) ){
if( beyond ){
/* ...end of char buffer then no decent length available */
} else {
/* take top of stack (hope it's numeric) */
if( len < 0 )
}
} else {
}
goto redo_switch;
}
}
if (new_s)
*new_s = s;
}
{
dSP;
#ifdef PACKED_IS_OCTETS
/* Packed side is assumed to be octets - so force downgrade if it
has been UTF-8 encoded by accident
*/
#else
#endif
PUSHs(&PL_sv_undef);
}
STATIC void
{
char hunk[5];
while (len > 2) {
s += 3;
len -= 3;
}
if (len > 0) {
}
}
{
bool skip = 1;
bool ignore = 0;
while (*s) {
switch (*s) {
case ' ':
break;
case '+':
if (!skip) {
return (NULL);
}
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
skip = 0;
if (!ignore) {
*(out++) = *s;
}
break;
case '.':
ignore = 1;
break;
default:
return (NULL);
}
s++;
}
*(out++) = '\0';
return (result);
}
/* pnum must be '\0' terminated */
STATIC int
{
int m = 0;
int r = 0;
char *t = s;
*done = 1;
while (*t) {
int i;
i = m * 10 + (*t - '0');
m = i & 0x7F;
r = (i >> 7); /* r < 10 */
if (r) {
*done = 0;
}
*(t++) = '0' + r;
}
*(t++) = '\0';
return (m);
}
/*
=for apidoc pack_cat
The engine implementing pack() Perl function. Note: parameters next_in_list and
flags are not used. This call should not be used; use packlist instead.
=cut */
void
Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
{
}
/*
=for apidoc packlist
The engine implementing pack() Perl function.
=cut */
void
Perl_packlist(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist )
{
}
SV **
{
/*SUPPRESS 442*/
static char null10[] = {0,0,0,0,0,0,0,0,0,0};
static char *space10 = " ";
bool found;
/* These must not be in registers: */
char achar;
int aint;
unsigned int auint;
#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
long double aldouble;
#endif
#ifdef HAS_QUAD
#endif
char *aptr;
float afloat;
double adouble;
#ifndef PACKED_IS_OCTETS
}
#endif
while (found) {
case e_no_len:
case e_number:
break;
case e_star:
break;
}
if (found){
} else {
}
}
switch(datumtype) {
default:
case '%':
case '@':
if (len > 0)
goto grow;
if (len > 0)
goto shrink;
break;
case '(':
{
while (len--) {
break; /* No way to continue */
}
break;
}
case 'X' | TYPE_IS_SHRIEKING:
if (!len) /* Avoid division by 0 */
len = 1;
/* FALL THROUGH */
case 'X':
break;
case 'x' | TYPE_IS_SHRIEKING:
if (!len) /* Avoid division by 0 */
len = 1;
if (aint) /* Other portable ways? */
else
len = 0;
/* FALL THROUGH */
case 'x':
grow:
while (len >= 10) {
len -= 10;
}
break;
case 'A':
case 'Z':
case 'a':
if (datumtype == 'Z')
++len;
}
if (datumtype == 'Z')
}
else {
if (datumtype == 'A') {
while (len >= 10) {
len -= 10;
}
}
else {
while (len >= 10) {
len -= 10;
}
}
}
break;
case 'B':
case 'b':
{
register char *str;
items = 0;
if (datumtype == 'B') {
if (len & 7)
items <<= 1;
else {
items = 0;
}
}
}
else {
if (*str++ & 1)
items |= 128;
if (len & 7)
items >>= 1;
else {
items = 0;
}
}
}
if (aint & 7) {
if (datumtype == 'B')
else
}
*aptr++ = '\0';
}
break;
case 'H':
case 'h':
{
register char *str;
items = 0;
if (datumtype == 'H') {
else
if (len & 1)
items <<= 4;
else {
items = 0;
}
}
}
else {
else
if (len & 1)
items >>= 4;
else {
items = 0;
}
}
}
if (aint & 1)
*aptr++ = '\0';
}
break;
case 'C':
case 'c':
while (len-- > 0) {
switch (datumtype) {
case 'C':
"Character in 'C' format wrapped in pack");
break;
case 'c':
"Character in 'c' format wrapped in pack" );
break;
}
}
break;
case 'U':
while (len-- > 0) {
0 : UNICODE_ALLOW_ANY)
}
break;
/* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
case 'f':
while (len-- > 0) {
#ifdef __VOS__
/* VOS does not automatically map a floating-point overflow
during conversion from double to float into infinity, so we
do it by hand. This code should either be generalized for
any OS that needs it, or removed if and when VOS implements
posix-976 (suggestion to support mapping to infinity).
Paul.Green@stratus.com 02-04-02. */
#else
/* IEEE fp overflow shenanigans are unavailable on VAX and optional
* on Alpha; fake it if we don't have them.
*/
# else
# endif
#endif
}
break;
case 'd':
while (len-- > 0) {
#ifdef __VOS__
/* VOS does not automatically map a floating-point overflow
during conversion from long double to double into infinity,
so we do it by hand. This code should either be generalized
for any OS that needs it, or removed if and when VOS
implements posix-976 (suggestion to support mapping to
infinity). Paul.Green@stratus.com 02-04-02. */
#else
/* IEEE fp overflow shenanigans are unavailable on VAX and optional
* on Alpha; fake it if we don't have them.
*/
# else
# endif
#endif
}
break;
case 'F':
while (len-- > 0) {
}
break;
#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
case 'D':
while (len-- > 0) {
}
break;
#endif
case 'n':
while (len-- > 0) {
#ifdef HAS_HTONS
#endif
}
break;
case 'v':
while (len-- > 0) {
#ifdef HAS_HTOVS
#endif
}
break;
case 'S' | TYPE_IS_SHRIEKING:
{
unsigned short aushort;
while (len-- > 0) {
}
}
break;
#else
/* Fall through! */
#endif
case 'S':
{
while (len-- > 0) {
}
}
break;
case 's' | TYPE_IS_SHRIEKING:
{
short ashort;
while (len-- > 0) {
}
}
break;
#else
/* Fall through! */
#endif
case 's':
while (len-- > 0) {
}
break;
case 'I':
case 'I' | TYPE_IS_SHRIEKING:
while (len-- > 0) {
}
break;
case 'j':
while (len-- > 0) {
}
break;
case 'J':
while (len-- > 0) {
}
break;
case 'w':
while (len-- > 0) {
if (anv < 0)
/* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0,
which is == UV_MAX_P1. IOK is fine (instead of UV_only), as
any negative IVs will have already been got by the croak()
above. IOK is untrue for fractions, so we test them
against UV_MAX_P1. */
{
do {
auv >>= 7;
} while (auv);
}
bool done;
/* Copy string and check for compliance */
while (!done)
}
/* 10**NV_MAX_10_EXP is the largest power of 10
so 10**(NV_MAX_10_EXP+1) is definately unrepresentable
given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x:
x = (NV_MAX_10_EXP+1) * log (10) / log (128)
And with that many bytes only Inf can overflow.
Some C compilers are strict about integral constant
expressions so we conservatively divide by a slightly
smaller integer instead of multiplying by the exact
floating-point value.
*/
#ifdef NV_MAX_10_EXP
/* char buf[1 + (int)((NV_MAX_10_EXP + 1) * 0.47456)]; -- invalid C */
#else
/* char buf[1 + (int)((308 + 1) * 0.47456)]; -- invalid C */
#endif
do {
} while (anv > 0);
}
else {
bool done;
/* Copy string and check for compliance */
while (!done)
}
}
break;
case 'i':
case 'i' | TYPE_IS_SHRIEKING:
while (len-- > 0) {
}
break;
case 'N':
while (len-- > 0) {
#ifdef HAS_HTONL
#endif
}
break;
case 'V':
while (len-- > 0) {
#ifdef HAS_HTOVL
#endif
}
break;
case 'L' | TYPE_IS_SHRIEKING:
{
unsigned long aulong;
while (len-- > 0) {
}
}
break;
#else
/* Fall though! */
#endif
case 'L':
{
while (len-- > 0) {
}
}
break;
case 'l' | TYPE_IS_SHRIEKING:
{
long along;
while (len-- > 0) {
}
}
break;
#else
/* Fall though! */
#endif
case 'l':
while (len-- > 0) {
}
break;
#ifdef HAS_QUAD
case 'Q':
while (len-- > 0) {
}
break;
case 'q':
while (len-- > 0) {
}
break;
#endif
case 'P':
/* Fall through! */
case 'p':
while (len-- > 0) {
if (fromstr == &PL_sv_undef)
else {
/* XXX better yet, could spirit away the string to
* a safe spot and hang on to it until the result
* of pack() (and all copies of the result) are
* gone.
*/
&& !SvREADONLY(fromstr))))
{
"Attempt to pack pointer to temporary value");
}
else
}
}
break;
case 'u':
if (len <= 2)
len = 45;
else
while (fromlen > 0) {
else
}
break;
}
}
return beglist;
}
{
MARK++;
}