1#define USE_OPTS 1 2 3#include <stdio.h> 4#include <stdlib.h> 5#include <time.h> 6#if USE_OPTS 7#include <limits.h> 8#include <string.h> 9#endif /* USE_OPTS */ 10#include "IBM390lib.h" 11/*------------------------------------------------------------------- 12 Module: Convert::IBM390 13 The C functions defined here are faster than straight Perl code. 14-------------------------------------------------------------------*/ 15 16 17 /* Powers of 10 */ 18static const double pows_of_10[32] = { 1.0, 10.0, 100.0, 1000.0, 19 10000.0, 100000.0, 1000000.0, 10000000.0, 20 1.0E8, 1.0E9, 1.0E10, 1.0E11, 1.0E12, 1.0E13, 1.0E14, 1.0E15, 21 1.0E16, 1.0E17, 1.0E18, 1.0E19, 1.0E20, 1.0E21, 1.0E22, 1.0E23, 22 1.0E24, 1.0E25, 1.0E26, 1.0E27, 1.0E28, 1.0E29, 1.0E30, 1.0E31 }; 23 24 /* Numeric values of packed digits (e.g. x'23' (decimal 23) = 0x17) */ 25unsigned char packed_digits[256] = { 26 0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0xff,0xff,0xff,0xff,0xff,0xff, 27 0x0a,0x0b,0x0c,0x0d,0x0e,0x0f,0x10,0x11,0x12,0x13,0xff,0xff,0xff,0xff,0xff,0xff, 28 0x14,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0xff,0xff,0xff,0xff,0xff,0xff, 29 0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0xff,0xff,0xff,0xff,0xff,0xff, 30 0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0xff,0xff,0xff,0xff,0xff,0xff, 31 0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0xff,0xff,0xff,0xff,0xff,0xff, 32 0x3c,0x3d,0x3e,0x3f,0x40,0x41,0x42,0x43,0x44,0x45,0xff,0xff,0xff,0xff,0xff,0xff, 33 0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0xff,0xff,0xff,0xff,0xff,0xff, 34 0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0xff,0xff,0xff,0xff,0xff,0xff, 35 0x5a,0x5b,0x5c,0x5d,0x5e,0x5f,0x60,0x61,0x62,0x63,0xff,0xff,0xff,0xff,0xff,0xff, 36 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 37 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 38 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 39 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 40 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 41 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff 42}; 43 44 /* Numeric values for last packed byte (digit + sign) */ 45unsigned char packed_lastbyte[256] = { 46 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, 47 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x01,0x01,0x01,0x01,0x01, 48 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x02,0x02,0x02,0x02,0x02,0x02, 49 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x03,0x03,0x03,0x03,0x03, 50 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x04,0x04,0x04,0x04,0x04,0x04, 51 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x05,0x05,0x05,0x05,0x05,0x05, 52 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x06,0x06,0x06,0x06,0x06,0x06, 53 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x07,0x07,0x07,0x07,0x07, 54 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x08,0x08,0x08,0x08,0x08,0x08, 55 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x09,0x09,0x09,0x09,0x09,0x09, 56 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 57 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 58 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 59 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 60 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 61 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff 62}; 63 64/*---------- Packed decimal to Perl number ----------*/ 65double CF_packed2num 66 ( const char * packed, 67 int plength, 68 int ndec ) 69{ 70 double out_num; 71 short i; 72 char * packed_ptr; 73 unsigned char pdigits, zonepart, numpart, signum; 74 unsigned char val; 75 unsigned long long out_long; 76 out_long = 0; 77 78#ifdef DEBUG390 79 fprintf(stderr, "*D* CF_packed2num: beginning\n"); 80#endif 81 out_num = 0.0; 82 packed_ptr = packed; 83 if (plength <= 9) { 84 for (i = 0; i < plength-1; i++) { 85 val = packed_digits[(unsigned char) *packed_ptr]; 86 if (val == 255) 87 { return INVALID_390NUM; } 88 out_long = (out_long * 100) + val; 89 packed_ptr++; 90 } 91 if (i < plength) { 92 pdigits = (unsigned char) *packed_ptr; 93 val = packed_lastbyte[pdigits]; 94 if (val == 255) 95 { return INVALID_390NUM; } 96 out_long = (out_long * 10) + val; 97 signum = pdigits & 0x0F; 98 } 99 out_num = out_long; 100 } else { 101 for (i = 0; i < plength-1; i++) { 102 val = packed_digits[(unsigned char) *packed_ptr]; 103 if (val == 255) 104 { return INVALID_390NUM; } 105 out_num = (out_num * 100) + val; 106 packed_ptr++; 107 } 108 if (i < plength) { 109 pdigits = (unsigned char) *packed_ptr; 110 val = packed_lastbyte[pdigits]; 111 if (val == 255) 112 { return INVALID_390NUM; } 113 out_num = (out_num * 10) + val; 114 signum = pdigits & 0x0F; 115 } 116 } 117 if (signum == 0x0D || signum == 0x0B) { 118 out_num = -out_num; 119 } 120 121 /* If ndec is 0, we're finished; if it's nonzero, 122 correct the number of decimal places. */ 123 if ( ndec != 0 ) { 124 out_num = out_num / pows_of_10[ndec]; 125 } 126 127#ifdef DEBUG390 128 fprintf(stderr, "*D* CF_packed2num: returning %f\n", out_num); 129#endif 130 return out_num; 131} 132 133#if USE_OPTS 134void 135fmt_num(char *buf, int sz, int len, unsigned long long val) 136{ 137 char *ptr = buf + len; 138 unsigned long long x; 139 *ptr-- = 0x00; 140 while (val > 0) { 141 x = val / 10; 142 *ptr-- = val - x * 10 + 0x30; 143 val = x; 144 } 145 memset(buf, 0x30, ptr-buf+1); 146} 147#endif /* USE_OPTS */ 148 149unsigned char to_packed[100] = { 150 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 151 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 152 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 153 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 154 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 155 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 156 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 157 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 158 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 159 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99 160}; 161 162 163/*---------- Perl number to packed decimal ----------*/ 164int CF_num2packed 165 ( char *packed_ptr, 166 double perlnum, 167 int outbytes, 168 int ndec, 169 int fsign ) 170{ 171 int outdigits, i; 172 double perl_absval; 173 long long int ll_absval; 174 char digits[36]; 175 char *digit_ptr, *out_ptr; 176 char signum; 177 178#ifdef DEBUG390 179 fprintf(stderr, "*D* CF_num2packed: beginning\n"); 180#endif 181 if (perlnum >= 0) { 182 perl_absval = perlnum; signum = (fsign) ? 0x0F : 0x0C; 183 } else { 184 perl_absval = 0 - perlnum; signum = 0x0D; 185 } 186 if (ndec > 0) { 187 perl_absval *= pows_of_10[ndec]; 188 } 189 /* Check for an excessively high value. */ 190 if (perl_absval >= 1.0E31) { 191 return 0; 192 } 193 194 /* If the number is less than LLONG_MAX, we can use integer functions. 195 Otherwise, we convert to a printed string and then pack it. */ 196 if (perl_absval < LLONG_MAX) { 197 ll_absval = (long long) (perl_absval + 0.5000001); 198 out_ptr = packed_ptr + outbytes - 1; 199 /* Last digit + sign */ 200 outdigits = ll_absval % 10; 201 *out_ptr-- = ((unsigned char)(outdigits << 4)) | signum; 202 ll_absval = ll_absval / 10; /* no remainder */ 203 /* Remaining digits */ 204 for (i = 0; i < outbytes - 1; i++) { 205 outdigits = ll_absval % 100; 206 *out_ptr = to_packed[outdigits]; 207 ll_absval = ll_absval / 100; /* no remainder */ 208 out_ptr--; 209 } 210 } else { 211 /* sprintf will round to an "integral" value. */ 212 sprintf(digits, "%031.0f", perl_absval); 213 outdigits = outbytes * 2 - 1; 214 digit_ptr = digits; 215 out_ptr = packed_ptr; 216 for (i = 31 - outdigits; i < 31; i += 2) { 217 if (i < 30) { 218 (*out_ptr) = ((*(digit_ptr + i)) << 4) | 219 ((*(digit_ptr + i + 1)) & 0x0F) ; 220 } else { 221 (*out_ptr) = ((*(digit_ptr + i)) << 4) | signum; 222 } 223 out_ptr++; 224 } 225 } 226 227#ifdef DEBUG390 228 fprintf(stderr, "*D* CF_num2packed: returning\n"); 229#endif 230 return 1; 231} 232 233 234/*---------- Zoned decimal to Perl number ----------*/ 235double CF_zoned2num 236 ( const char * zoned, 237 int plength, 238 int ndec ) 239{ 240 double out_num; 241 short i; 242 unsigned char zdigit, signum; 243 244#ifdef DEBUG390 245 fprintf(stderr, "*D* CF_zoned2num: beginning\n"); 246#endif 247 out_num = 0.0; 248 for (i = 0; i < plength - 1; i++) { 249 zdigit = (unsigned char) *(zoned + i); 250 if (zdigit < 0xF0 || zdigit > 0xF9) 251 { return INVALID_390NUM; } 252 out_num = (out_num * 10) + (zdigit - 240); /* i.e. 0xF0 */ 253 } 254 /* Last digit (may have a zone overpunch) */ 255 zdigit = (unsigned char) *(zoned + i); 256 if ((zdigit & 0xF0) < 0xA0 || (zdigit & 0x0F) > 0x09) 257 { return INVALID_390NUM; } 258 out_num = (out_num * 10) + (zdigit & 0x0F); 259 signum = zdigit & 0xF0; 260 261 if (signum == 0xD0 || signum == 0xB0) { 262 out_num = -out_num; 263 } 264 265 /* If ndec is 0, we're finished; if it's nonzero, 266 correct the number of decimal places. */ 267 if ( ndec != 0 ) { 268 out_num = out_num / pows_of_10[ndec]; 269 } 270 271#ifdef DEBUG390 272 fprintf(stderr, "*D* CF_zoned2num: returning %f\n", out_num); 273#endif 274 return out_num; 275} 276 277unsigned char to_zoned[10] = 278 {0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9 }; 279 280/*---------- Perl number to zoned decimal ----------*/ 281int CF_num2zoned 282 ( char *zoned_ptr, 283 double perlnum, 284 int outbytes, 285 int ndec, 286 int fsign ) 287{ 288 int outdigits, i; 289 double perl_absval; 290 long long int ll_absval; 291 char digits[36]; 292 char *digit_ptr, *out_ptr; 293 unsigned char signum; 294 295#ifdef DEBUG390 296 fprintf(stderr, "*D* CF_num2zoned: beginning\n"); 297#endif 298 if (perlnum >= 0) { 299 perl_absval = perlnum; signum = (fsign) ? 0xF0 : 0xC0; 300 } else { 301 perl_absval = 0 - perlnum; signum = 0xD0; 302 } 303 if (ndec > 0) { 304 perl_absval *= pows_of_10[ndec]; 305 } 306 /* Check for an excessively high value. */ 307 if (perl_absval >= 1.0E31) { 308 return 0; 309 } 310 311 /* If the number is less than LLONG_MAX, we can use integer functions 312 without having to convert to a formatted string first. 313 Otherwise, we use sprintf to format the number and then convert to 314 EBCDIC (zoned). */ 315 if (perl_absval < LLONG_MAX) { 316 ll_absval = (long long) (perl_absval + 0.5000001); 317 out_ptr = zoned_ptr + outbytes - 1; 318 /* Last digit + sign */ 319 outdigits = ll_absval % 10; 320 *out_ptr-- = ((unsigned char) outdigits) | signum; 321 ll_absval = ll_absval / 10; /* no remainder */ 322 /* Remaining digits */ 323 for (i = 0; i < outbytes - 1; i++) { 324 outdigits = ll_absval % 10; 325 *out_ptr = to_zoned[outdigits]; 326 ll_absval = ll_absval / 10; /* no remainder */ 327 out_ptr--; 328 } 329 } else { 330 /* sprintf will round to an "integral" value. */ 331 sprintf(digits, "%031.0f", perl_absval); 332 digit_ptr = digits + 31 - outbytes; 333 out_ptr = zoned_ptr; 334 for (i = 31 - outbytes; i < 31; i++) { 335 if (i < 30) { 336 *out_ptr = to_zoned[*digit_ptr - '0']; 337 } else { 338 *out_ptr = (*digit_ptr - '0') | signum; 339 } 340 digit_ptr++; 341 out_ptr++; 342 } 343 } 344 345#ifdef DEBUG390 346 fprintf(stderr, "*D* CF_num2zoned: returning\n"); 347#endif 348 return 1; 349} 350 351 352/*---------- Full Collating Sequence Translate ---------- 353 * This function is like tr/// but assumes that the searchstring 354 * is a complete 8-bit collating sequence (x'00' - x'FF'). 355 * The last argument is one of the translation tables defined 356 * in IBM390.xs (a2e_table, etc.). 357 *-------------------------------------------------------*/ 358void CF_fcs_xlate 359 ( char *outstring, 360 char *instring, 361 int instring_len, 362 unsigned char *to_table ) 363{ 364 char *out_ptr; 365 unsigned char offset; 366 register int i; 367 368#ifdef DEBUG390 369 fprintf(stderr, "*D* CF_fcs_xlate: beginning\n"); 370#endif 371 out_ptr = outstring; 372 for (i = 0; i < instring_len; i++) { 373 offset = (unsigned char) *(instring + i); 374 (*out_ptr) = *(to_table + offset); 375 out_ptr++; 376 } 377 378#ifdef DEBUG390 379 fprintf(stderr, "*D* CF_fcs_xlate: returning\n"); 380#endif 381 return; 382} 383 384 385/*---------- Long integer to System/390 fullword ----------*/ 386void _to_S390fw ( 387 char * out_word, 388 long n ) 389{ 390 long comp; 391 392 if (n >= 0) { 393 out_word[0] = (char) (n / 16777216); 394 out_word[1] = (char) (n / 65536) % 256; 395 out_word[2] = (char) (n / 256) % 256; 396 out_word[3] = (char) (n % 256); 397 } else { 398 comp = (-n) - 1; /* Complement */ 399 out_word[0] = (char) (comp / 16777216); 400 out_word[1] = (char) (comp / 65536) % 256; 401 out_word[2] = (char) (comp / 256) % 256; 402 out_word[3] = (char) (comp % 256); 403 /* Invert all bits. */ 404 out_word[0] = out_word[0] ^ 0xFF; 405 out_word[1] = out_word[1] ^ 0xFF; 406 out_word[2] = out_word[2] ^ 0xFF; 407 out_word[3] = out_word[3] ^ 0xFF; 408 } 409 return; 410} 411 412 413/*---------- Long integer to System/390 halfword ----------*/ 414void _to_S390hw ( 415 char * out_word, 416 long n ) 417{ 418 long comp; 419 420 if (n > 32767 || n < -32768) { 421 n = n % 32768; 422 } 423 if (n >= 0) { 424 out_word[0] = (char) (n / 256); 425 out_word[1] = (char) (n % 256); 426 } else { 427 comp = (-n) - 1; /* Complement */ 428 out_word[0] = (char) (comp / 256); 429 out_word[1] = (char) (comp % 256); 430 /* Invert all bits. */ 431 out_word[0] = out_word[0] ^ 0xFF; 432 out_word[1] = out_word[1] ^ 0xFF; 433 } 434 return; 435} 436 437 438/*---------- _halfword ----------*/ 439/* This function returns the value of a Sys/390 halfword (a signed 440 16-bit big-endian integer). */ 441int _halfword ( 442 char * hw_ptr ) 443{ 444 return (((signed char) hw_ptr[0]) << 8) 445 + (unsigned char) hw_ptr[1]; 446} 447 448