OpenCOBOL 1.1pre-rel
move.c
Go to the documentation of this file.
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 }
 All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Defines