#define USE_OPTS 1

#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#if USE_OPTS
#include <limits.h>
#include <string.h>
#endif /* USE_OPTS */
#include "IBM390lib.h"
/*-------------------------------------------------------------------
  Module:  Convert::IBM390
  The C functions defined here are faster than straight Perl code.
-------------------------------------------------------------------*/


 /* Powers of 10 */
static const double pows_of_10[32] = { 1.0, 10.0, 100.0, 1000.0,
  10000.0,  100000.0,  1000000.0,  10000000.0,
  1.0E8,  1.0E9,  1.0E10, 1.0E11, 1.0E12, 1.0E13, 1.0E14, 1.0E15,
  1.0E16, 1.0E17, 1.0E18, 1.0E19, 1.0E20, 1.0E21, 1.0E22, 1.0E23,
  1.0E24, 1.0E25, 1.0E26, 1.0E27, 1.0E28, 1.0E29, 1.0E30, 1.0E31 };

 /* Numeric values of packed digits (e.g. x'23' (decimal 23) = 0x17) */
unsigned char packed_digits[256] = {
 0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0xff,0xff,0xff,0xff,0xff,0xff,
 0x0a,0x0b,0x0c,0x0d,0x0e,0x0f,0x10,0x11,0x12,0x13,0xff,0xff,0xff,0xff,0xff,0xff,
 0x14,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0xff,0xff,0xff,0xff,0xff,0xff,
 0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0xff,0xff,0xff,0xff,0xff,0xff,
 0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0xff,0xff,0xff,0xff,0xff,0xff,
 0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0xff,0xff,0xff,0xff,0xff,0xff,
 0x3c,0x3d,0x3e,0x3f,0x40,0x41,0x42,0x43,0x44,0x45,0xff,0xff,0xff,0xff,0xff,0xff,
 0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0xff,0xff,0xff,0xff,0xff,0xff,
 0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0xff,0xff,0xff,0xff,0xff,0xff,
 0x5a,0x5b,0x5c,0x5d,0x5e,0x5f,0x60,0x61,0x62,0x63,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff 
};

 /* Numeric values for last packed byte (digit + sign) */
unsigned char packed_lastbyte[256] = {
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x01,0x01,0x01,0x01,0x01,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x02,0x02,0x02,0x02,0x02,0x02,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x03,0x03,0x03,0x03,0x03,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x04,0x04,0x04,0x04,0x04,0x04,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x05,0x05,0x05,0x05,0x05,0x05,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x06,0x06,0x06,0x06,0x06,0x06,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x07,0x07,0x07,0x07,0x07,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x08,0x08,0x08,0x08,0x08,0x08,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x09,0x09,0x09,0x09,0x09,0x09,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff 
};

/*---------- Packed decimal to Perl number ----------*/
double  CF_packed2num
  ( const char * packed,
    int    plength,
    int    ndec )
{
 double  out_num;
 short   i;
 char * packed_ptr;
 unsigned char  pdigits, zonepart, numpart, signum;
 unsigned char val;
 unsigned long long out_long;
 out_long = 0;

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_packed2num: beginning\n");
#endif
 out_num = 0.0;
 packed_ptr = packed;
 if (plength <= 9) {
   for (i = 0; i < plength-1; i++) {
      val = packed_digits[(unsigned char) *packed_ptr];
      if (val == 255)
          { return INVALID_390NUM; }
      out_long = (out_long * 100) + val;
      packed_ptr++;
   }
   if (i < plength) {
      pdigits = (unsigned char) *packed_ptr;
      val = packed_lastbyte[pdigits];
      if (val == 255)
         { return INVALID_390NUM; }
      out_long = (out_long * 10) + val;
      signum = pdigits & 0x0F;
   }
   out_num = out_long;
 } else {
   for (i = 0; i < plength-1; i++) {
      val = packed_digits[(unsigned char) *packed_ptr];
      if (val == 255)
          { return INVALID_390NUM; }
      out_num = (out_num * 100) + val;
      packed_ptr++;
   }
   if (i < plength) {
      pdigits = (unsigned char) *packed_ptr;
      val = packed_lastbyte[pdigits];
      if (val == 255)
         { return INVALID_390NUM; }
      out_num = (out_num * 10) + val;
      signum = pdigits & 0x0F;
   }
 }
 if (signum == 0x0D || signum == 0x0B) {
    out_num = -out_num;
 }

  /* If ndec is 0, we're finished; if it's nonzero,
     correct the number of decimal places. */
 if ( ndec != 0 ) {
    out_num = out_num / pows_of_10[ndec];
 }

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_packed2num: returning %f\n", out_num);
#endif
 return out_num;
}

#if USE_OPTS
void
fmt_num(char *buf, int sz, int len, unsigned long long val)
{
	char *ptr = buf + len;
	unsigned long long x;
	*ptr-- = 0x00;
	while (val > 0) {
		x = val / 10;
		*ptr-- = val - x * 10 + 0x30;
		val = x;
	}
	memset(buf, 0x30, ptr-buf+1);
}
#endif /* USE_OPTS */

unsigned char to_packed[100] = {
 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09,
 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19,
 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29,
 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39,
 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49,
 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59,
 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69,
 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79,
 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89,
 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99
};
 

/*---------- Perl number to packed decimal ----------*/
int  CF_num2packed
  ( char  *packed_ptr,
    double perlnum,
    int    outbytes,
    int    ndec,
    int    fsign )
{
 int     outdigits, i;
 double  perl_absval;
 long long int  ll_absval;
 char    digits[36];
 char   *digit_ptr, *out_ptr;
 char    signum;

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_num2packed: beginning\n");
#endif
 if (perlnum >= 0) {
    perl_absval = perlnum;   signum = (fsign) ? 0x0F : 0x0C;
 } else {
    perl_absval = 0 - perlnum;  signum = 0x0D;
 }
 if (ndec > 0) {
    perl_absval *= pows_of_10[ndec];
 }
   /* Check for an excessively high value. */
 if (perl_absval >= 1.0E31) {
    return 0;
 }

 /* If the number is less than LLONG_MAX, we can use integer functions.
    Otherwise, we convert to a printed string and then pack it. */
 if (perl_absval < LLONG_MAX) {
	ll_absval = (long long) (perl_absval + 0.5000001);
	out_ptr = packed_ptr + outbytes - 1;
	  /* Last digit + sign */
	outdigits = ll_absval % 10;
	*out_ptr-- = ((unsigned char)(outdigits << 4)) | signum;
	ll_absval = ll_absval / 10;  /* no remainder */
	  /* Remaining digits */
	for (i = 0; i < outbytes - 1; i++) {
	   outdigits = ll_absval % 100;
	   *out_ptr = to_packed[outdigits];
	   ll_absval = ll_absval / 100;  /* no remainder */
	   out_ptr--;
  	} 
 } else {
	  /* sprintf will round to an "integral" value. */
	sprintf(digits, "%031.0f", perl_absval);
	outdigits = outbytes * 2 - 1;
	digit_ptr = digits;
	out_ptr = packed_ptr;
	for (i = 31 - outdigits; i < 31; i += 2) {
	   if (i < 30) {
	      (*out_ptr) = ((*(digit_ptr + i)) << 4) |
	         ((*(digit_ptr + i + 1)) & 0x0F) ;
	   } else {
	      (*out_ptr) = ((*(digit_ptr + i)) << 4) | signum;
	   }
	   out_ptr++;
  	} 
 }

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_num2packed: returning\n");
#endif
 return 1;
}


/*---------- Zoned decimal to Perl number ----------*/
double  CF_zoned2num
  ( const char * zoned,
    int    plength,
    int    ndec )
{
 double  out_num;
 short   i;
 unsigned char  zdigit, signum;

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_zoned2num: beginning\n");
#endif
 out_num = 0.0;
 for (i = 0; i < plength - 1; i++) {
    zdigit = (unsigned char) *(zoned + i);
    if (zdigit < 0xF0 || zdigit > 0xF9)
      { return INVALID_390NUM; }
    out_num = (out_num * 10) + (zdigit - 240);  /* i.e. 0xF0 */
 }
   /* Last digit (may have a zone overpunch) */
 zdigit = (unsigned char) *(zoned + i);
 if ((zdigit & 0xF0) < 0xA0 || (zdigit & 0x0F) > 0x09)
    { return INVALID_390NUM; }
 out_num = (out_num * 10) + (zdigit & 0x0F);
 signum = zdigit & 0xF0;

 if (signum == 0xD0 || signum == 0xB0) {
    out_num = -out_num;
 }

  /* If ndec is 0, we're finished; if it's nonzero,
     correct the number of decimal places. */
 if ( ndec != 0 ) {
    out_num = out_num / pows_of_10[ndec];
 }

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_zoned2num: returning %f\n", out_num);
#endif
 return out_num;
}

unsigned char to_zoned[10] =
 {0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9 };

/*---------- Perl number to zoned decimal ----------*/
int  CF_num2zoned
  ( char  *zoned_ptr,
    double perlnum,
    int    outbytes,
    int    ndec,
    int    fsign )
{
 int     outdigits, i;
 double  perl_absval;
 long long int  ll_absval;
 char    digits[36];
 char   *digit_ptr, *out_ptr;
 unsigned char signum;

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_num2zoned: beginning\n");
#endif
 if (perlnum >= 0) {
    perl_absval = perlnum;     signum = (fsign) ? 0xF0 : 0xC0;
 } else {
    perl_absval = 0 - perlnum; signum = 0xD0;
 }
 if (ndec > 0) {
    perl_absval *= pows_of_10[ndec];
 }
   /* Check for an excessively high value. */
 if (perl_absval >= 1.0E31) {
    return 0;
 }

 /* If the number is less than LLONG_MAX, we can use integer functions
    without having to convert to a formatted string first.
    Otherwise, we use sprintf to format the number and then convert to
    EBCDIC (zoned). */
 if (perl_absval < LLONG_MAX) {
	ll_absval = (long long) (perl_absval + 0.5000001);
	out_ptr = zoned_ptr + outbytes - 1;
	  /* Last digit + sign */
	outdigits = ll_absval % 10;
	*out_ptr-- = ((unsigned char) outdigits) | signum;
	ll_absval = ll_absval / 10;  /* no remainder */
	  /* Remaining digits */
	for (i = 0; i < outbytes - 1; i++) {
	   outdigits = ll_absval % 10;
	   *out_ptr = to_zoned[outdigits];
	   ll_absval = ll_absval / 10;  /* no remainder */
	   out_ptr--;
  	} 
 } else {
	  /* sprintf will round to an "integral" value. */
 	sprintf(digits, "%031.0f", perl_absval);
	digit_ptr = digits + 31 - outbytes;
	out_ptr = zoned_ptr;
	for (i = 31 - outbytes; i < 31; i++) {
	   if (i < 30) {
	      *out_ptr = to_zoned[*digit_ptr - '0'];
	   } else {
	      *out_ptr = (*digit_ptr - '0') | signum;
	   }
	   digit_ptr++;
	   out_ptr++;
 	}
 }

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_num2zoned: returning\n");
#endif
 return 1;
}


/*---------- Full Collating Sequence Translate ----------
 * This function is like tr/// but assumes that the searchstring
 * is a complete 8-bit collating sequence (x'00' - x'FF').
 * The last argument is one of the translation tables defined
 * in IBM390.xs (a2e_table, etc.).
 *-------------------------------------------------------*/
void  CF_fcs_xlate
  ( char  *outstring,
    char  *instring,
    int    instring_len,
    unsigned char  *to_table )
{
 char  *out_ptr;
 unsigned char offset;
 register int    i;

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_fcs_xlate: beginning\n");
#endif
 out_ptr = outstring;
 for (i = 0; i < instring_len; i++) {
    offset = (unsigned char) *(instring + i);
    (*out_ptr) = *(to_table + offset);
    out_ptr++;
 }

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_fcs_xlate: returning\n");
#endif
 return;
}


/*---------- Long integer to System/390 fullword ----------*/
void _to_S390fw (
  char * out_word,
  long   n )
{
 long  comp;

 if (n >= 0) {
    out_word[0] = (char) (n / 16777216);
    out_word[1] = (char) (n / 65536) % 256;
    out_word[2] = (char) (n / 256) % 256;
    out_word[3] = (char) (n % 256);
 } else {
    comp = (-n) - 1;  /* Complement */
    out_word[0] = (char) (comp / 16777216);
    out_word[1] = (char) (comp / 65536) % 256;
    out_word[2] = (char) (comp / 256) % 256;
    out_word[3] = (char) (comp % 256);
     /* Invert all bits. */
    out_word[0] = out_word[0] ^ 0xFF;
    out_word[1] = out_word[1] ^ 0xFF;
    out_word[2] = out_word[2] ^ 0xFF;
    out_word[3] = out_word[3] ^ 0xFF;
 }
 return;
}


/*---------- Long integer to System/390 halfword ----------*/
void _to_S390hw (
  char * out_word,
  long   n )
{
 long  comp;

 if (n > 32767 || n < -32768) {
    n = n % 32768;
 }
 if (n >= 0) {
    out_word[0] = (char) (n / 256);
    out_word[1] = (char) (n % 256);
 } else {
    comp = (-n) - 1;  /* Complement */
    out_word[0] = (char) (comp / 256);
    out_word[1] = (char) (comp % 256);
     /* Invert all bits. */
    out_word[0] = out_word[0] ^ 0xFF;
    out_word[1] = out_word[1] ^ 0xFF;
 }
 return;
}


/*---------- _halfword ----------*/
/* This function returns the value of a Sys/390 halfword (a signed
   16-bit big-endian integer). */
int _halfword (
  char * hw_ptr )
{
  return  (((signed char) hw_ptr[0]) << 8)
        + (unsigned char) hw_ptr[1];
}