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