#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#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 };


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

#ifdef DEBUG390
  fprintf(stderr, "*D* CF_packed2num: beginning\n");
#endif
 out_num = 0.0;
 for (i = 0; i < plength; i++) {
    pdigits = (unsigned char) *(packed + i);
    zonepart = pdigits >> 4;
    numpart = pdigits & 0x0F;
    if (i < plength - 1) {
       if ((zonepart > 0x09) || (numpart > 0x09))
          { return INVALID_390NUM; }
       out_num = (out_num * 100) + (zonepart * 10) + numpart;
    } else {
       if ((zonepart > 0x09) || (numpart < 0x0A))
          { return INVALID_390NUM; }
       out_num = (out_num * 10) + zonepart;
       signum = numpart;
    }
 }
 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;
}


/*---------- 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;
 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;
 }

   /* 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; i++) {
    zdigit = (unsigned char) *(zoned + i);
    if (i < plength - 1) {
       if (zdigit < 0xF0 || zdigit > 0xF9)
          { return INVALID_390NUM; }
       out_num = (out_num * 10) + (zdigit - 240);  /* i.e. 0xF0 */
    } else {
       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;
}


/*---------- Perl number to zoned decimal ----------*/
int  CF_num2zoned
  ( char  *zoned_ptr,
    double perlnum,
    int    outbytes,
    int    ndec,
    int    fsign )
{
 int     i;
 double  perl_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;
 }

   /* sprintf will round to an "integral" value. */
 sprintf(digits, "%031.0f", perl_absval);
 digit_ptr = digits;
 out_ptr = zoned_ptr;
 for (i = 31 - outbytes; i < 31; i++) {
    if (i < 30) {
       (*out_ptr) = (*(digit_ptr + i) - '0') | 0xF0;
    } else {
       (*out_ptr) = (*(digit_ptr + i) - '0') | signum;
    }
    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];
}