|
OpenCOBOL 1.1pre-rel
|
|
OpenCOBOL 1.1pre-rel
|
00001 /* 00002 * Copyright (C) 2002-2009 Keisuke Nishida 00003 * Copyright (C) 2007-2009 Roger While 00004 * 00005 * This library is free software; you can redistribute it and/or 00006 * modify it under the terms of the GNU Lesser General Public License 00007 * as published by the Free Software Foundation; either version 2.1, 00008 * or (at your option) any later version. 00009 * 00010 * This library is distributed in the hope that it will be useful, 00011 * but WITHOUT ANY WARRANTY; without even the implied warranty of 00012 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00013 * GNU Lesser General Public License for more details. 00014 * 00015 * You should have received a copy of the GNU Lesser General Public 00016 * License along with this library; see the file COPYING.LIB. If 00017 * not, write to the Free Software Foundation, 51 Franklin Street, Fifth Floor 00018 * Boston, MA 02110-1301 USA 00019 */ 00020 00021 #include "config.h" 00022 00023 #include <stdio.h> 00024 #include <stdlib.h> 00025 #include <string.h> 00026 #include <ctype.h> 00027 #include <math.h> 00028 00029 #include "move.h" 00030 #include "coblocal.h" 00031 #include "byteswap.h" 00032 00033 static size_t lastsize = 0; 00034 static unsigned char *lastdata = NULL; 00035 00036 static const int cob_exp10[10] = { 00037 1, 00038 10, 00039 100, 00040 1000, 00041 10000, 00042 100000, 00043 1000000, 00044 10000000, 00045 100000000, 00046 1000000000 00047 }; 00048 00049 static const long long cob_exp10LL[19] = { 00050 1LL, 00051 10LL, 00052 100LL, 00053 1000LL, 00054 10000LL, 00055 100000LL, 00056 1000000LL, 00057 10000000LL, 00058 100000000LL, 00059 1000000000LL, 00060 10000000000LL, 00061 100000000000LL, 00062 1000000000000LL, 00063 10000000000000LL, 00064 100000000000000LL, 00065 1000000000000000LL, 00066 10000000000000000LL, 00067 100000000000000000LL, 00068 1000000000000000000LL 00069 }; 00070 00071 static COB_INLINE int 00072 cob_min_int (const int x, const int y) 00073 { 00074 if (x < y) { 00075 return x; 00076 } 00077 return y; 00078 } 00079 00080 static COB_INLINE int 00081 cob_max_int (const int x, const int y) 00082 { 00083 if (x > y) { 00084 return x; 00085 } 00086 return y; 00087 } 00088 00089 static COB_INLINE void 00090 own_byte_memcpy (unsigned char *s1, const unsigned char *s2, size_t size) 00091 { 00092 do { 00093 *s1++ = *s2++; 00094 } while (--size); 00095 } 00096 00097 static void 00098 store_common_region (cob_field *f, const unsigned char *data, 00099 const size_t size, const int scale) 00100 { 00101 const unsigned char *p; 00102 unsigned char *q; 00103 size_t csize; 00104 size_t cinc; 00105 int lf1 = -scale; 00106 int lf2 = -COB_FIELD_SCALE (f); 00107 int hf1 = (int) size + lf1; 00108 int hf2 = (int) COB_FIELD_SIZE (f) + lf2; 00109 int lcf; 00110 int gcf; 00111 00112 lcf = cob_max_int (lf1, lf2); 00113 gcf = cob_min_int (hf1, hf2); 00114 memset (COB_FIELD_DATA (f), '0', COB_FIELD_SIZE (f)); 00115 if (gcf > lcf) { 00116 csize = (size_t)(gcf - lcf); 00117 p = data + hf1 - gcf; 00118 q = COB_FIELD_DATA (f) + hf2 - gcf; 00119 for (cinc = 0; cinc < csize; ++cinc, ++p, ++q) { 00120 if (unlikely(*p == ' ')) { 00121 *q = (unsigned char)'0'; 00122 } else { 00123 *q = *p; 00124 } 00125 } 00126 } 00127 } 00128 00129 static long long 00130 cob_binary_mget_int64 (const cob_field * const f) 00131 { 00132 long long n = 0; 00133 size_t fsiz = 8 - f->size; 00134 00135 /* Experimental code - not activated */ 00136 #if 0 00137 unsigned char *s; 00138 00139 if ((COB_FIELD_BINARY_SWAP (f) && !COB_FIELD_HAVE_SIGN (f)) || 00140 (!COB_FIELD_BINARY_SWAP (f) && COB_FIELD_HAVE_SIGN (f))) { 00141 s = (unsigned char *)&n + fsiz; 00142 } else { 00143 s = (unsigned char *)&n; 00144 } 00145 own_byte_memcpy (s, f->data, f->size); 00146 if (COB_FIELD_BINARY_SWAP (f)) { 00147 n = COB_BSWAP_64 (n); 00148 } 00149 if (COB_FIELD_HAVE_SIGN (f)) { 00150 n >>= 8 * fsiz; /* shift with sign */ 00151 } 00152 #endif 00153 #ifndef WORDS_BIGENDIAN 00154 if (COB_FIELD_BINARY_SWAP (f)) { 00155 if (COB_FIELD_HAVE_SIGN (f)) { 00156 own_byte_memcpy ((unsigned char *)&n, f->data, f->size); 00157 n = COB_BSWAP_64 (n); 00158 n >>= 8 * fsiz; /* shift with sign */ 00159 } else { 00160 own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); 00161 n = COB_BSWAP_64 (n); 00162 } 00163 } else { 00164 if (COB_FIELD_HAVE_SIGN (f)) { 00165 own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); 00166 n >>= 8 * fsiz; /* shift with sign */ 00167 } else { 00168 own_byte_memcpy ((unsigned char *)&n, f->data, f->size); 00169 } 00170 } 00171 #else /* WORDS_BIGENDIAN */ 00172 if (COB_FIELD_HAVE_SIGN (f)) { 00173 own_byte_memcpy ((unsigned char *)&n, f->data, f->size); 00174 n >>= 8 * fsiz; /* shift with sign */ 00175 } else { 00176 own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); 00177 } 00178 #endif /* WORDS_BIGENDIAN */ 00179 return n; 00180 } 00181 00182 static void 00183 cob_binary_mset_int64 (cob_field *f, long long n) 00184 { 00185 #ifndef WORDS_BIGENDIAN 00186 unsigned char *s; 00187 00188 if (COB_FIELD_BINARY_SWAP (f)) { 00189 n = COB_BSWAP_64 (n); 00190 s = ((unsigned char *)&n) + 8 - f->size; 00191 } else { 00192 s = (unsigned char *)&n; 00193 } 00194 own_byte_memcpy (f->data, s, f->size); 00195 #else /* WORDS_BIGENDIAN */ 00196 own_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size); 00197 #endif /* WORDS_BIGENDIAN */ 00198 } 00199 00200 /* 00201 * Display 00202 */ 00203 00204 static void 00205 cob_move_alphanum_to_display (cob_field *f1, cob_field *f2) 00206 { 00207 unsigned char *p; 00208 unsigned char *s1; 00209 unsigned char *s2; 00210 unsigned char *e1; 00211 unsigned char *e2; 00212 int sign, count, size; 00213 unsigned char c; 00214 00215 /* initialize */ 00216 s1 = f1->data; 00217 e1 = s1 + f1->size; 00218 s2 = COB_FIELD_DATA (f2); 00219 e2 = s2 + COB_FIELD_SIZE (f2); 00220 memset (f2->data, '0', f2->size); 00221 00222 /* skip white spaces */ 00223 for (; s1 < e1; ++s1) { 00224 if (!isspace (*s1)) { 00225 break; 00226 } 00227 } 00228 00229 /* check for sign */ 00230 sign = 0; 00231 if (s1 != e1) { 00232 if (*s1 == '+' || *s1 == '-') { 00233 sign = (*s1++ == '+') ? 1 : -1; 00234 } 00235 } 00236 00237 /* count the number of digits before decimal point */ 00238 count = 0; 00239 for (p = s1; p < e1 && *p != cob_current_module->decimal_point; ++p) { 00240 if (isdigit (*p)) { 00241 ++count; 00242 } 00243 } 00244 00245 /* find the start position */ 00246 size = (int) COB_FIELD_SIZE (f2) - COB_FIELD_SCALE(f2); 00247 if (count < size) { 00248 s2 += size - count; 00249 } else { 00250 while (count-- > size) { 00251 while (!isdigit (*s1++)) { 00252 ; 00253 } 00254 } 00255 } 00256 00257 /* move */ 00258 count = 0; 00259 for (; s1 < e1 && s2 < e2; ++s1) { 00260 c = *s1; 00261 if (isdigit (c)) { 00262 *s2++ = c; 00263 } else if (c == cob_current_module->decimal_point) { 00264 if (count++ > 0) { 00265 goto error; 00266 } 00267 } else if (!(isspace (c) || c == cob_current_module->numeric_separator)) { 00268 goto error; 00269 } 00270 } 00271 00272 cob_put_sign (f2, sign); 00273 return; 00274 00275 error: 00276 memset (f2->data, '0', f2->size); 00277 cob_put_sign (f2, 0); 00278 } 00279 00280 static void 00281 cob_move_display_to_display (cob_field *f1, cob_field *f2) 00282 { 00283 int sign; 00284 00285 sign = cob_get_sign (f1); 00286 store_common_region (f2, COB_FIELD_DATA (f1), COB_FIELD_SIZE (f1), 00287 COB_FIELD_SCALE (f1)); 00288 00289 cob_put_sign (f1, sign); 00290 cob_put_sign (f2, sign); 00291 } 00292 00293 static void 00294 cob_move_display_to_alphanum (cob_field *f1, cob_field *f2) 00295 { 00296 unsigned char *data1; 00297 unsigned char *data2; 00298 size_t size1; 00299 size_t size2; 00300 int sign; 00301 int diff; 00302 int zero_size; 00303 00304 data1 = COB_FIELD_DATA (f1); 00305 size1 = COB_FIELD_SIZE (f1); 00306 sign = cob_get_sign (f1); 00307 data2 = f2->data; 00308 size2 = f2->size; 00309 if (size1 >= size2) { 00310 memcpy (data2, data1, size2); 00311 } else { 00312 diff = (int)(size2 - size1); 00313 zero_size = 0; 00314 /* move */ 00315 memcpy (data2, data1, size1); 00316 /* implied 0 ('P's) */ 00317 if (COB_FIELD_SCALE(f1) < 0) { 00318 zero_size = cob_min_int ((int)-COB_FIELD_SCALE(f1), diff); 00319 memset (data2 + size1, '0', (size_t)zero_size); 00320 } 00321 /* padding */ 00322 if (diff - zero_size > 0) { 00323 memset (data2 + size1 + zero_size, ' ', (size_t)(diff - zero_size)); 00324 } 00325 } 00326 00327 cob_put_sign (f1, sign); 00328 } 00329 00330 static void 00331 cob_move_alphanum_to_alphanum (cob_field *f1, cob_field *f2) 00332 { 00333 unsigned char *data1; 00334 unsigned char *data2; 00335 size_t size1; 00336 size_t size2; 00337 00338 data1 = f1->data; 00339 size1 = f1->size; 00340 data2 = f2->data; 00341 size2 = f2->size; 00342 if (size1 >= size2) { 00343 /* move string with truncation */ 00344 if (COB_FIELD_JUSTIFIED (f2)) { 00345 memcpy (data2, data1 + size1 - size2, size2); 00346 } else { 00347 memcpy (data2, data1, size2); 00348 } 00349 } else { 00350 /* move string with padding */ 00351 if (COB_FIELD_JUSTIFIED (f2)) { 00352 memset (data2, ' ', size2 - size1); 00353 memcpy (data2 + size2 - size1, data1, size1); 00354 } else { 00355 memcpy (data2, data1, size1); 00356 memset (data2 + size1, ' ', size2 - size1); 00357 } 00358 } 00359 } 00360 00361 /* 00362 * Packed decimal 00363 */ 00364 00365 static void 00366 cob_move_display_to_packed (cob_field *f1, cob_field *f2) 00367 { 00368 unsigned char *data1; 00369 unsigned char *data2; 00370 unsigned char *p; 00371 size_t digits1; 00372 size_t digits2; 00373 size_t i; 00374 size_t offset; 00375 int sign; 00376 int scale1; 00377 int scale2; 00378 unsigned char n; 00379 00380 sign = cob_get_sign (f1); 00381 data1 = COB_FIELD_DATA (f1); 00382 digits1 = COB_FIELD_DIGITS (f1); 00383 scale1 = COB_FIELD_SCALE (f1); 00384 data2 = f2->data; 00385 digits2 = COB_FIELD_DIGITS (f2); 00386 scale2 = COB_FIELD_SCALE (f2); 00387 00388 /* pack string */ 00389 memset (f2->data, 0, f2->size); 00390 offset = 1 - (digits2 % 2); 00391 p = data1 + (digits1 - scale1) - (digits2 - scale2); 00392 for (i = offset; i < digits2 + offset; ++i, ++p) { 00393 if (*p == ' ') { 00394 n = 0; 00395 } else { 00396 n = (data1 <= p && p < data1 + digits1) ? cob_d2i (*p) : 0; 00397 } 00398 if (i % 2 == 0) { 00399 data2[i / 2] = n << 4; 00400 } else { 00401 data2[i / 2] |= n; 00402 } 00403 } 00404 00405 cob_put_sign (f1, sign); 00406 p = f2->data + f2->size - 1; 00407 if (!COB_FIELD_HAVE_SIGN (f2)) { 00408 *p = (*p & 0xf0) | 0x0f; 00409 } else if (sign < 0) { 00410 *p = (*p & 0xf0) | 0x0d; 00411 } else { 00412 *p = (*p & 0xf0) | 0x0c; 00413 } 00414 } 00415 00416 static void 00417 cob_move_packed_to_display (cob_field *f1, cob_field *f2) 00418 { 00419 unsigned char *data; 00420 size_t i; 00421 size_t offset; 00422 int sign; 00423 unsigned char buff[64]; 00424 00425 /* unpack string */ 00426 data = f1->data; 00427 sign = cob_get_sign (f1); 00428 offset = 1 - (COB_FIELD_DIGITS(f1) % 2); 00429 for (i = offset; i < COB_FIELD_DIGITS(f1) + offset; ++i) { 00430 if (i % 2 == 0) { 00431 buff[i - offset] = cob_i2d (data[i / 2] >> 4); 00432 } else { 00433 buff[i - offset] = cob_i2d (data[i / 2] & 0x0f); 00434 } 00435 } 00436 00437 /* store */ 00438 store_common_region (f2, buff, COB_FIELD_DIGITS (f1), COB_FIELD_SCALE (f1)); 00439 00440 cob_put_sign (f2, sign); 00441 } 00442 00443 /* 00444 * Floating point 00445 */ 00446 00447 static void 00448 cob_move_display_to_fp (cob_field *f1, cob_field *f2) 00449 { 00450 double val; 00451 size_t size; 00452 int sign = cob_get_sign (f1); 00453 size_t size1 = COB_FIELD_SIZE (f1); 00454 char *data1; 00455 char buff2[64]; 00456 00457 memset ((ucharptr)buff2, 0, sizeof (buff2)); 00458 size = size1 - COB_FIELD_SCALE(f1); 00459 if (sign < 0) { 00460 buff2[0] = '-'; 00461 data1 = &buff2[1]; 00462 } else { 00463 data1 = buff2; 00464 } 00465 if (COB_FIELD_SCALE(f1) <= 0) { 00466 snprintf (data1, 63, "%*.*s.0", (int)size, (int)size, f1->data); 00467 } else { 00468 snprintf (data1, 63, "%*.*s.%*.*s", (int)size, (int)size, f1->data, 00469 COB_FIELD_SCALE(f1), COB_FIELD_SCALE(f1), f1->data + size); 00470 } 00471 sscanf (buff2, "%lf", &val); 00472 if (COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_FLOAT) { 00473 float flval = (float) val; 00474 00475 memcpy (f2->data, (ucharptr)&flval, sizeof(float)); 00476 } else { 00477 memcpy (f2->data, (ucharptr)&val, sizeof(double)); 00478 } 00479 } 00480 00481 static void 00482 cob_move_fp_to_display (cob_field *f1, cob_field *f2) 00483 { 00484 double val; 00485 double frac; 00486 double intgr; 00487 int sign; 00488 int decs; 00489 long long res; 00490 char *x, *y; 00491 char buff[64]; 00492 char buff2[64]; 00493 00494 memset ((ucharptr)buff, 0, sizeof (buff)); 00495 memset ((ucharptr)buff2, 0, sizeof (buff2)); 00496 if (COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_FLOAT) { 00497 float flval; 00498 00499 memcpy ((ucharptr)&flval, f1->data, sizeof (float)); 00500 val = flval; 00501 } else { 00502 memcpy ((ucharptr)&val, f1->data, sizeof (double)); 00503 } 00504 sign = 1; 00505 if (val < 0) { 00506 sign = -1; 00507 val = -val; 00508 } 00509 frac = modf (val, &intgr); 00510 res = (long long) intgr; 00511 decs = 0; 00512 for (; res; res /= 10) { 00513 ++decs; 00514 } 00515 snprintf (buff2, 63, "%-18.*lf", 18 - decs, val); 00516 y = buff; 00517 for (x = buff2; *x; ++x) { 00518 if (*x == '.') { 00519 continue; 00520 } 00521 if (*x == ' ') { 00522 continue; 00523 } 00524 *y++ = *x; 00525 } 00526 00527 store_common_region (f2, (ucharptr)buff, strlen (buff), 18 - decs); 00528 cob_put_sign (f2, sign); 00529 } 00530 00531 /* 00532 * Binary integer 00533 */ 00534 00535 static void 00536 cob_move_display_to_binary (cob_field *f1, cob_field *f2) 00537 { 00538 unsigned char *data1; 00539 size_t i, size; 00540 size_t size1; 00541 long long val = 0; 00542 int sign; 00543 00544 size1 = COB_FIELD_SIZE (f1); 00545 data1 = COB_FIELD_DATA (f1); 00546 sign = cob_get_sign (f1); 00547 /* get value */ 00548 size = size1 - COB_FIELD_SCALE(f1) + COB_FIELD_SCALE(f2); 00549 for (i = 0; i < size; ++i) { 00550 if (i < size1) { 00551 val = val * 10 + cob_d2i (data1[i]); 00552 } else { 00553 val = val * 10; 00554 } 00555 } 00556 if (sign < 0 && COB_FIELD_HAVE_SIGN (f2)) { 00557 val = -val; 00558 } 00559 if (cob_current_module->flag_binary_truncate && 00560 !COB_FIELD_REAL_BINARY(f2)) { 00561 val %= cob_exp10LL[(int)COB_FIELD_DIGITS(f2)]; 00562 } 00563 00564 /* store */ 00565 cob_binary_mset_int64 (f2, val); 00566 00567 cob_put_sign (f1, sign); 00568 } 00569 00570 static void 00571 cob_move_binary_to_display (cob_field *f1, cob_field *f2) 00572 { 00573 int i, sign; 00574 unsigned long long val; 00575 long long val2; 00576 char buff[64]; /* long long is at most 20 digits */ 00577 00578 sign = 1; 00579 /* get value */ 00580 if (COB_FIELD_HAVE_SIGN (f1)) { 00581 val2 = cob_binary_mget_int64 (f1); 00582 if (val2 < 0) { 00583 sign = -1; 00584 val = -val2; 00585 } else { 00586 val = val2; 00587 } 00588 } else { 00589 val = cob_binary_mget_int64 (f1); 00590 } 00591 00592 /* convert to string */ 00593 i = 20; 00594 while (val > 0) { 00595 buff[--i] = (char) cob_i2d (val % 10); 00596 val /= 10; 00597 } 00598 00599 /* store */ 00600 store_common_region (f2, (ucharptr)buff + i, (size_t)(20 - i), 00601 COB_FIELD_SCALE(f1)); 00602 00603 cob_put_sign (f2, sign); 00604 } 00605 00606 /* 00607 * Edited 00608 */ 00609 00610 static void 00611 cob_move_display_to_edited (cob_field *f1, cob_field *f2) 00612 { 00613 const char *p; 00614 unsigned char *min, *max, *src, *dst, *end; 00615 unsigned char *decimal_point; 00616 int sign; 00617 int neg; 00618 int count = 0; 00619 int count_sign = 1; 00620 int count_curr = 1; 00621 int trailing_sign = 0; 00622 int trailing_curr = 0; 00623 int is_zero = 1; 00624 int suppress_zero = 1; 00625 int sign_first = 0; 00626 int p_is_left = 0; 00627 int repeat; 00628 int n; 00629 unsigned char pad = ' '; 00630 unsigned char x; 00631 unsigned char c; 00632 unsigned char sign_symbol = 0; 00633 unsigned char curr_symbol = 0; 00634 00635 decimal_point = NULL; 00636 sign = cob_get_sign (f1); 00637 neg = (sign < 0) ? 1 : 0; 00638 /* count the number of digit places before decimal point */ 00639 for (p = COB_FIELD_PIC (f2); *p; p += 5) { 00640 c = p[0]; 00641 memcpy ((unsigned char *)&repeat, p + 1, sizeof(int)); 00642 if (c == '9' || c == 'Z' || c == '*') { 00643 count += repeat; 00644 count_sign = 0; 00645 count_curr = 0; 00646 } else if (count_curr && c == cob_current_module->currency_symbol) { 00647 count += repeat; 00648 } else if (count_sign && (c == '+' || c == '-')) { 00649 count += repeat; 00650 } else if (c == 'P') { 00651 if (count == 0) { 00652 p_is_left = 1; 00653 break; 00654 } else { 00655 count += repeat; 00656 count_sign = 0; 00657 count_curr = 0; 00658 } 00659 } else if (c == 'V' || c == cob_current_module->decimal_point) { 00660 break; 00661 } 00662 } 00663 00664 min = COB_FIELD_DATA (f1); 00665 max = min + COB_FIELD_SIZE (f1); 00666 src = max - COB_FIELD_SCALE(f1) - count; 00667 dst = f2->data; 00668 end = f2->data + f2->size; 00669 for (p = COB_FIELD_PIC (f2); *p;) { 00670 c = *p++; /* PIC char */ 00671 memcpy ((unsigned char *)&n, p, sizeof(int)); /* PIC char count */ 00672 p += sizeof(int); 00673 for (; n > 0; n--, ++dst) { 00674 switch (c) { 00675 case '0': 00676 case '/': 00677 *dst = c; 00678 break; 00679 00680 case 'B': 00681 *dst = suppress_zero ? pad : 'B'; 00682 break; 00683 00684 case 'P': 00685 if (p_is_left) { 00686 ++src; 00687 --dst; 00688 } 00689 break; 00690 00691 case '9': 00692 *dst = (min <= src && src < max) ? *src++ : (src++, '0'); 00693 if (*dst != '0') { 00694 is_zero = suppress_zero = 0; 00695 } 00696 suppress_zero = 0; 00697 trailing_sign = 1; 00698 trailing_curr = 1; 00699 break; 00700 00701 case 'V': 00702 --dst; 00703 decimal_point = dst; 00704 break; 00705 00706 case '.': 00707 case ',': 00708 if (c == cob_current_module->decimal_point) { 00709 *dst = cob_current_module->decimal_point; 00710 decimal_point = dst; 00711 } else { 00712 *dst = suppress_zero ? pad : c; 00713 } 00714 break; 00715 00716 case 'C': 00717 case 'D': 00718 end = dst; 00719 memcpy (dst++, neg ? (c == 'C' ? "CR" : "DB") : " ", 2); 00720 break; 00721 00722 case 'Z': 00723 case '*': 00724 x = (min <= src && src < max) ? *src++ : (src++, '0'); 00725 if (x != '0') { 00726 is_zero = suppress_zero = 0; 00727 } 00728 pad = (c == '*') ? '*' : ' '; 00729 *dst = suppress_zero ? pad : x; 00730 trailing_sign = 1; 00731 trailing_curr = 1; 00732 break; 00733 00734 case '+': 00735 case '-': 00736 x = (min <= src && src < max) ? *src++ : (src++, '0'); 00737 if (x != '0') { 00738 is_zero = suppress_zero = 0; 00739 } 00740 if (trailing_sign) { 00741 *dst = neg ? '-' : (c == '+') ? '+' : ' '; 00742 --end; 00743 } else if (dst == f2->data || suppress_zero) { 00744 *dst = pad; 00745 sign_symbol = neg ? '-' : (c == '+') ? '+' : ' '; 00746 if (!curr_symbol) { 00747 ++sign_first; 00748 } 00749 } else { 00750 *dst = x; 00751 } 00752 break; 00753 00754 default: 00755 if (c == cob_current_module->currency_symbol) { 00756 x = (min <= src && src < max) ? *src++ : (src++, '0'); 00757 if (x != '0') { 00758 is_zero = suppress_zero = 0; 00759 } 00760 if (trailing_curr) { 00761 *dst = cob_current_module->currency_symbol; 00762 --end; 00763 } else if (dst == f2->data || suppress_zero) { 00764 *dst = pad; 00765 curr_symbol = cob_current_module->currency_symbol; 00766 } else { 00767 *dst = x; 00768 } 00769 break; 00770 } 00771 00772 *dst = '?'; /* invalid PIC */ 00773 } 00774 } 00775 } 00776 00777 if (suppress_zero || (is_zero && COB_FIELD_BLANK_ZERO (f2))) { 00778 /* all digits are zeros */ 00779 if (pad == ' ' || COB_FIELD_BLANK_ZERO (f2)) { 00780 memset (f2->data, ' ', f2->size); 00781 } else { 00782 for (dst = f2->data; dst < f2->data + f2->size; ++dst) { 00783 if (*dst != cob_current_module->decimal_point) { 00784 *dst = pad; 00785 } 00786 } 00787 } 00788 } else { 00789 /* put zero after the decimal point if necessary */ 00790 if (decimal_point) { 00791 for (dst = decimal_point + 1; dst < end; ++dst) { 00792 if (!isdigit (*dst) && !strchr (",+-/B", *dst)) { 00793 *dst = '0'; 00794 } 00795 } 00796 } 00797 00798 /* put sign or currency symbol at the beginning */ 00799 if (sign_symbol || curr_symbol) { 00800 for (dst = end - 1; dst > f2->data; --dst) { 00801 if (*dst == ' ') { 00802 break; 00803 } 00804 } 00805 if (sign_symbol && curr_symbol) { 00806 if (sign_first) { 00807 *dst = curr_symbol; 00808 --dst; 00809 if (dst >= f2->data) { 00810 *dst = sign_symbol; 00811 } 00812 } else { 00813 *dst = sign_symbol; 00814 --dst; 00815 if (dst >= f2->data) { 00816 *dst = curr_symbol; 00817 } 00818 } 00819 } else if (sign_symbol) { 00820 *dst = sign_symbol; 00821 } else { 00822 *dst = curr_symbol; 00823 } 00824 } 00825 00826 /* replace all 'B's by pad */ 00827 count = 0; 00828 for (dst = f2->data; dst < end; ++dst) { 00829 if (*dst == 'B') { 00830 if (count == 0) { 00831 *dst = pad; 00832 } else { 00833 *dst = ' '; 00834 } 00835 } else { 00836 ++count; 00837 } 00838 } 00839 } 00840 00841 cob_put_sign (f1, sign); 00842 } 00843 00844 static void 00845 cob_move_edited_to_display (cob_field *f1, cob_field *f2) 00846 { 00847 unsigned char *p; 00848 const char *p1; 00849 size_t i; 00850 int sign = 0; 00851 int scale = 0; 00852 int count = 0; 00853 int have_point = 0; 00854 int cp; 00855 int n; 00856 unsigned char c; 00857 unsigned char buff[64]; 00858 00859 p = buff; 00860 /* de-edit */ 00861 for (i = 0; i < f1->size; ++i) { 00862 cp = f1->data[i]; 00863 switch (cp) { 00864 case '0': 00865 case '1': 00866 case '2': 00867 case '3': 00868 case '4': 00869 case '5': 00870 case '6': 00871 case '7': 00872 case '8': 00873 case '9': 00874 *p++ = cp; 00875 if (have_point) { 00876 ++scale; 00877 } 00878 break; 00879 case '.': 00880 case ',': 00881 if (cp == cob_current_module->decimal_point) { 00882 have_point = 1; 00883 } 00884 break; 00885 case '-': 00886 case 'C': 00887 sign = -1; 00888 break; 00889 } 00890 } 00891 /* count the number of digit places after decimal point in case of 'V', 'P' */ 00892 if (scale == 0) { 00893 for (p1 = COB_FIELD_PIC (f1); *p1; p1 += 5) { 00894 c = p1[0]; 00895 memcpy ((unsigned char *)&n, p1 + 1, sizeof(int)); 00896 if (c == '9' || c == '0' || c == 'Z' || c == '*') { 00897 if (have_point) { 00898 scale += n; 00899 } else { 00900 count += n; 00901 } 00902 } else if (c == 'P') { 00903 if (count == 0) { 00904 have_point = 1; 00905 scale += n; 00906 } else { 00907 scale -= n; 00908 } 00909 } else if (c == 'V') { 00910 have_point = 1; 00911 } 00912 } 00913 } 00914 00915 /* store */ 00916 store_common_region (f2, buff, (size_t)(p - buff), scale); 00917 00918 cob_put_sign (f2, sign); 00919 } 00920 00921 static void 00922 cob_move_alphanum_to_edited (cob_field *f1, cob_field *f2) 00923 { 00924 const char *p; 00925 unsigned char *max, *src, *dst; 00926 int sign = cob_get_sign (f1); 00927 int n; 00928 unsigned char c; 00929 00930 src = COB_FIELD_DATA (f1); 00931 max = src + COB_FIELD_SIZE (f1); 00932 dst = f2->data; 00933 for (p = COB_FIELD_PIC (f2); *p;) { 00934 c = *p++; /* PIC char */ 00935 memcpy ((unsigned char *)&n, p, sizeof(int)); /* PIC char count */ 00936 p += sizeof(int); 00937 for (; n > 0; --n) { 00938 switch (c) { 00939 case 'A': 00940 case 'X': 00941 case '9': 00942 *dst++ = (src < max) ? *src++ : ' '; 00943 break; 00944 case '0': 00945 case '/': 00946 *dst++ = c; 00947 break; 00948 case 'B': 00949 *dst++ = ' '; 00950 break; 00951 default: 00952 *dst++ = '?'; /* invalid PIC */ 00953 } 00954 } 00955 } 00956 cob_put_sign (f1, sign); 00957 } 00958 00959 /* 00960 * MOVE dispatcher 00961 */ 00962 00963 static void 00964 indirect_move (void (*func) (cob_field *src, cob_field *dst), 00965 cob_field *src, cob_field *dst, size_t size, int scale) 00966 { 00967 cob_field temp; 00968 cob_field_attr attr; 00969 unsigned char data[64]; 00970 00971 COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, size, scale, 00972 COB_FLAG_HAVE_SIGN, NULL); 00973 temp.size = size; 00974 temp.data = data; 00975 temp.attr = &attr; 00976 func (src, &temp); 00977 cob_move (&temp, dst); 00978 } 00979 00980 static void 00981 cob_move_all (cob_field *src, cob_field *dst) 00982 { 00983 size_t i; 00984 size_t digcount; 00985 cob_field temp; 00986 cob_field_attr attr; 00987 00988 COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); 00989 if (COB_FIELD_IS_NUMERIC(dst)) { 00990 digcount = 18; 00991 attr.type = COB_TYPE_NUMERIC_DISPLAY; 00992 attr.digits = 18; 00993 /* 00994 if (COB_FIELD_TYPE(dst) & COB_TYPE_NUMERIC_EDITED) { 00995 digcount = dst->size; 00996 } else { 00997 digcount = COB_FIELD_DIGITS(dst); 00998 } 00999 */ 01000 } else { 01001 digcount = dst->size; 01002 } 01003 if (digcount > lastsize) { 01004 free (lastdata); 01005 lastdata = cob_malloc (digcount); 01006 lastsize = digcount; 01007 } 01008 temp.size = digcount; 01009 temp.data = lastdata; 01010 temp.attr = &attr; 01011 if (likely(src->size == 1)) { 01012 memset (lastdata, src->data[0], digcount); 01013 } else { 01014 for (i = 0; i < digcount; ++i) { 01015 lastdata[i] = src->data[i % src->size]; 01016 } 01017 } 01018 01019 cob_move (&temp, dst); 01020 } 01021 01022 void 01023 cob_move (cob_field *src, cob_field *dst) 01024 { 01025 if (COB_FIELD_TYPE (src) == COB_TYPE_ALPHANUMERIC_ALL) { 01026 cob_move_all (src, dst); 01027 return; 01028 } 01029 if (dst->size == 0) { 01030 return; 01031 } 01032 if (src->size == 0) { 01033 src = &cob_space; 01034 } 01035 01036 /* non-elementary move */ 01037 if (COB_FIELD_TYPE (src) == COB_TYPE_GROUP || COB_FIELD_TYPE (dst) == COB_TYPE_GROUP) { 01038 cob_move_alphanum_to_alphanum (src, dst); 01039 return; 01040 } 01041 01042 /* elementary move */ 01043 switch (COB_FIELD_TYPE (src)) { 01044 case COB_TYPE_NUMERIC_DISPLAY: 01045 switch (COB_FIELD_TYPE (dst)) { 01046 case COB_TYPE_NUMERIC_FLOAT: 01047 case COB_TYPE_NUMERIC_DOUBLE: 01048 cob_move_display_to_fp (src, dst); 01049 return; 01050 case COB_TYPE_NUMERIC_DISPLAY: 01051 cob_move_display_to_display (src, dst); 01052 return; 01053 case COB_TYPE_NUMERIC_PACKED: 01054 cob_move_display_to_packed (src, dst); 01055 return; 01056 case COB_TYPE_NUMERIC_BINARY: 01057 cob_move_display_to_binary (src, dst); 01058 return; 01059 case COB_TYPE_NUMERIC_EDITED: 01060 cob_move_display_to_edited (src, dst); 01061 return; 01062 case COB_TYPE_ALPHANUMERIC_EDITED: 01063 if (COB_FIELD_SCALE(src) < 0 || 01064 COB_FIELD_SCALE(src) > COB_FIELD_DIGITS(src)) { 01065 /* expand P's */ 01066 indirect_move (cob_move_display_to_display, src, dst, 01067 (size_t)cob_max_int ((int)COB_FIELD_DIGITS(src), (int)COB_FIELD_SCALE(src)), 01068 cob_max_int (0, (int)COB_FIELD_SCALE(src))); 01069 return; 01070 } else { 01071 cob_move_alphanum_to_edited (src, dst); 01072 return; 01073 } 01074 default: 01075 cob_move_display_to_alphanum (src, dst); 01076 return; 01077 } 01078 01079 case COB_TYPE_NUMERIC_PACKED: 01080 switch (COB_FIELD_TYPE (dst)) { 01081 case COB_TYPE_NUMERIC_DISPLAY: 01082 cob_move_packed_to_display (src, dst); 01083 return; 01084 default: 01085 indirect_move (cob_move_packed_to_display, src, dst, 01086 COB_FIELD_DIGITS(src), COB_FIELD_SCALE(src)); 01087 return; 01088 } 01089 01090 case COB_TYPE_NUMERIC_BINARY: 01091 switch (COB_FIELD_TYPE (dst)) { 01092 case COB_TYPE_NUMERIC_DISPLAY: 01093 cob_move_binary_to_display (src, dst); 01094 return; 01095 case COB_TYPE_NUMERIC_BINARY: 01096 case COB_TYPE_NUMERIC_PACKED: 01097 case COB_TYPE_NUMERIC_EDITED: 01098 case COB_TYPE_NUMERIC_FLOAT: 01099 case COB_TYPE_NUMERIC_DOUBLE: 01100 indirect_move (cob_move_binary_to_display, src, dst, 01101 20, COB_FIELD_SCALE(src)); 01102 return; 01103 default: 01104 indirect_move (cob_move_binary_to_display, src, dst, 01105 COB_FIELD_DIGITS(src), COB_FIELD_SCALE(src)); 01106 return; 01107 } 01108 01109 case COB_TYPE_NUMERIC_EDITED: 01110 switch (COB_FIELD_TYPE (dst)) { 01111 case COB_TYPE_NUMERIC_DISPLAY: 01112 cob_move_edited_to_display (src, dst); 01113 return; 01114 case COB_TYPE_NUMERIC_PACKED: 01115 case COB_TYPE_NUMERIC_BINARY: 01116 case COB_TYPE_NUMERIC_EDITED: 01117 case COB_TYPE_NUMERIC_FLOAT: 01118 case COB_TYPE_NUMERIC_DOUBLE: 01119 indirect_move (cob_move_edited_to_display, src, dst, 36, 18); 01120 return; 01121 case COB_TYPE_ALPHANUMERIC_EDITED: 01122 cob_move_alphanum_to_edited (src, dst); 01123 return; 01124 default: 01125 cob_move_alphanum_to_alphanum (src, dst); 01126 return; 01127 } 01128 01129 case COB_TYPE_NUMERIC_FLOAT: 01130 case COB_TYPE_NUMERIC_DOUBLE: 01131 indirect_move (cob_move_fp_to_display, src, dst, 40, 20); 01132 return; 01133 01134 default: 01135 switch (COB_FIELD_TYPE (dst)) { 01136 case COB_TYPE_NUMERIC_DISPLAY: 01137 cob_move_alphanum_to_display (src, dst); 01138 return; 01139 case COB_TYPE_NUMERIC_PACKED: 01140 case COB_TYPE_NUMERIC_BINARY: 01141 case COB_TYPE_NUMERIC_EDITED: 01142 case COB_TYPE_NUMERIC_FLOAT: 01143 case COB_TYPE_NUMERIC_DOUBLE: 01144 indirect_move (cob_move_alphanum_to_display, src, dst, 36, 18); 01145 return; 01146 case COB_TYPE_ALPHANUMERIC_EDITED: 01147 cob_move_alphanum_to_edited (src, dst); 01148 return; 01149 default: 01150 cob_move_alphanum_to_alphanum (src, dst); 01151 return; 01152 } 01153 } 01154 } 01155 01156 /* 01157 * Convenience functions 01158 */ 01159 01160 static int 01161 cob_packed_get_int (cob_field *f1) 01162 { 01163 unsigned char *data; 01164 size_t i; 01165 size_t offset; 01166 int val = 0; 01167 int sign; 01168 01169 data = f1->data; 01170 sign = cob_get_sign (f1); 01171 offset = 1 - (COB_FIELD_DIGITS(f1) % 2); 01172 for (i = offset; i < COB_FIELD_DIGITS(f1) - COB_FIELD_SCALE(f1) + offset; ++i) { 01173 val *= 10; 01174 if (i % 2 == 0) { 01175 val += data[i / 2] >> 4; 01176 } else { 01177 val += data[i / 2] & 0x0f; 01178 } 01179 } 01180 if (sign < 0) { 01181 val = -val; 01182 } 01183 return val; 01184 } 01185 01186 static long long 01187 cob_packed_get_long_long (cob_field *f1) 01188 { 01189 unsigned char *data; 01190 size_t i; 01191 size_t offset; 01192 long long val = 0; 01193 int sign; 01194 01195 data = f1->data; 01196 sign = cob_get_sign (f1); 01197 offset = 1 - (COB_FIELD_DIGITS(f1) % 2); 01198 for (i = offset; i < COB_FIELD_DIGITS(f1) - COB_FIELD_SCALE(f1) + offset; ++i) { 01199 val *= 10; 01200 if (i % 2 == 0) { 01201 val += data[i / 2] >> 4; 01202 } else { 01203 val += data[i / 2] & 0x0f; 01204 } 01205 } 01206 if (sign < 0) { 01207 val = -val; 01208 } 01209 return val; 01210 } 01211 01212 static int 01213 cob_display_get_int (cob_field *f) 01214 { 01215 unsigned char *data; 01216 size_t size; 01217 size_t i; 01218 int val = 0; 01219 int sign; 01220 01221 size = COB_FIELD_SIZE (f); 01222 data = COB_FIELD_DATA (f); 01223 sign = cob_get_sign (f); 01224 /* skip preceding zeros */ 01225 for (i = 0; i < size; ++i) { 01226 if (cob_d2i (data[i]) != 0) { 01227 break; 01228 } 01229 } 01230 01231 /* get value */ 01232 if (COB_FIELD_SCALE(f) < 0) { 01233 for (; i < size; ++i) { 01234 val = val * 10 + cob_d2i (data[i]); 01235 } 01236 val *= cob_exp10[(int)-COB_FIELD_SCALE(f)]; 01237 } else { 01238 size -= COB_FIELD_SCALE(f); 01239 for (; i < size; ++i) { 01240 val = val * 10 + cob_d2i (data[i]); 01241 } 01242 } 01243 if (sign < 0) { 01244 val = -val; 01245 } 01246 01247 cob_put_sign (f, sign); 01248 return val; 01249 } 01250 01251 static long long 01252 cob_display_get_long_long (cob_field *f) 01253 { 01254 unsigned char *data; 01255 size_t size; 01256 size_t i; 01257 long long val = 0; 01258 int sign; 01259 01260 size = COB_FIELD_SIZE (f); 01261 data = COB_FIELD_DATA (f); 01262 sign = cob_get_sign (f); 01263 /* skip preceding zeros */ 01264 for (i = 0; i < size; ++i) { 01265 if (cob_d2i (data[i]) != 0) { 01266 break; 01267 } 01268 } 01269 01270 /* get value */ 01271 if (COB_FIELD_SCALE(f) < 0) { 01272 for (; i < size; ++i) { 01273 val = val * 10 + cob_d2i (data[i]); 01274 } 01275 val *= cob_exp10LL[(int)-COB_FIELD_SCALE(f)]; 01276 } else { 01277 size -= COB_FIELD_SCALE(f); 01278 for (; i < size; ++i) { 01279 val = val * 10 + cob_d2i (data[i]); 01280 } 01281 } 01282 if (sign < 0) { 01283 val = -val; 01284 } 01285 01286 cob_put_sign (f, sign); 01287 return val; 01288 } 01289 01290 void 01291 cob_set_int (cob_field *f, int n) 01292 { 01293 cob_field temp; 01294 cob_field_attr attr; 01295 01296 COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, COB_FLAG_HAVE_SIGN, NULL); 01297 temp.size = 4; 01298 temp.data = (unsigned char *)&n; 01299 temp.attr = &attr; 01300 cob_move (&temp, f); 01301 } 01302 01303 int 01304 cob_get_int (cob_field *f) 01305 { 01306 int n; 01307 cob_field temp; 01308 cob_field_attr attr; 01309 01310 switch (COB_FIELD_TYPE (f)) { 01311 case COB_TYPE_NUMERIC_DISPLAY: 01312 return cob_display_get_int (f); 01313 case COB_TYPE_NUMERIC_BINARY: 01314 return (int)cob_binary_mget_int64 (f); 01315 case COB_TYPE_NUMERIC_PACKED: 01316 return cob_packed_get_int (f); 01317 default: 01318 COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, 01319 COB_FLAG_HAVE_SIGN, NULL); 01320 temp.size = 4; 01321 temp.data = (unsigned char *)&n; 01322 temp.attr = &attr; 01323 cob_move (f, &temp); 01324 return n; 01325 } 01326 } 01327 01328 long long 01329 cob_get_long_long (cob_field *f) 01330 { 01331 long long n; 01332 cob_field temp; 01333 cob_field_attr attr; 01334 01335 switch (COB_FIELD_TYPE (f)) { 01336 case COB_TYPE_NUMERIC_DISPLAY: 01337 return cob_display_get_long_long (f); 01338 case COB_TYPE_NUMERIC_BINARY: 01339 return cob_binary_mget_int64 (f); 01340 case COB_TYPE_NUMERIC_PACKED: 01341 return cob_packed_get_long_long (f); 01342 default: 01343 COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, 01344 COB_FLAG_HAVE_SIGN, NULL); 01345 temp.size = 8; 01346 temp.data = (unsigned char *)&n; 01347 temp.attr = &attr; 01348 cob_move (f, &temp); 01349 return n; 01350 } 01351 } 01352 01353 void 01354 cob_init_move (void) 01355 { 01356 lastdata = cob_malloc (COB_SMALL_BUFF); 01357 lastsize = COB_SMALL_BUFF; 01358 }
1.7.4
