#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];
}