GnuCOBOL  2.0
A free COBOL compiler
 All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Macros
Macros | Functions | Variables
move.c File Reference
#include "config.h"
#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
#include <ctype.h>
#include <errno.h>
#include <math.h>
#include "libcob.h"
#include "coblocal.h"
Include dependency graph for move.c:

Macros

#define COB_LIB_EXPIMP
 

Functions

static COB_INLINE int cob_min_int (const int x, const int y)
 
static COB_INLINE int cob_max_int (const int x, const int y)
 
static COB_INLINE COB_A_INLINE void own_byte_memcpy (unsigned char *s1, const unsigned char *s2, size_t size)
 
static int cob_packed_get_sign (const cob_field *f)
 
static void store_common_region (cob_field *f, const unsigned char *data, const size_t size, const int scale)
 
static COB_INLINE COB_A_INLINE
cob_s64_t 		cob_binary_mget_sint64 (const cob_field *const f)
 
static COB_INLINE COB_A_INLINE
cob_u64_t 		cob_binary_mget_uint64 (const cob_field *const f)
 
static COB_INLINE COB_A_INLINE void cob_binary_mset_sint64 (cob_field *f, cob_s64_t n)
 
static COB_INLINE COB_A_INLINE void cob_binary_mset_uint64 (cob_field *f, cob_u64_t n)
 
static void cob_move_alphanum_to_display (cob_field *f1, cob_field *f2)
 
static void cob_move_display_to_display (cob_field *f1, cob_field *f2)
 
static void cob_move_display_to_alphanum (cob_field *f1, cob_field *f2)
 
static void cob_move_alphanum_to_alphanum (cob_field *f1, cob_field *f2)
 
static void cob_move_display_to_packed (cob_field *f1, cob_field *f2)
 
static void cob_move_packed_to_display (cob_field *f1, cob_field *f2)
 
static void cob_move_fp_to_fp (cob_field *src, cob_field *dst)
 
static void cob_move_binary_to_binary (cob_field *f1, cob_field *f2)
 
static void cob_move_display_to_binary (cob_field *f1, cob_field *f2)
 
static void cob_move_binary_to_display (cob_field *f1, cob_field *f2)
 
static void cob_move_display_to_edited (cob_field *f1, cob_field *f2)
 
static void cob_move_edited_to_display (cob_field *f1, cob_field *f2)
 
static void cob_move_alphanum_to_edited (cob_field *f1, cob_field *f2)
 
static void indirect_move (void(*func)(cob_field *src, cob_field *dst), cob_field *src, cob_field *dst, const size_t size, const int scale)
 
static void cob_move_all (cob_field *src, cob_field *dst)
 
void cob_move (cob_field *src, cob_field *dst)
 
static int cob_packed_get_int (cob_field *f1)
 
static cob_s64_t cob_packed_get_long_long (cob_field *f1)
 
static int cob_display_get_int (cob_field *f)
 
static cob_s64_t cob_display_get_long_long (cob_field *f)
 
void cob_set_int (cob_field *f, const int n)
 
int cob_get_int (cob_field *f)
 
cob_s64_t cob_get_llint (cob_field *f)
 
void cob_init_move (cob_global *lptr, runtime_env *runtimeptr)
 

Variables

static cob_global * cobglobptr
 
static const cob_field_attr const_alpha_attr
 
static const cob_field_attr const_binll_attr
 
static const int cob_exp10 [10]
 
static const cob_s64_t cob_exp10_ll [19]
 

Macro Definition Documentation

#define COB_LIB_EXPIMP

Function Documentation

static COB_INLINE COB_A_INLINE cob_s64_t cob_binary_mget_sint64 ( const cob_field *const  f)
static

References COB_BSWAP_64, COB_FIELD_BINARY_SWAP, COB_FIELD_HAVE_SIGN, cob_s64_t, cob_field::data, own_byte_memcpy(), and cob_field::size.

Referenced by cob_get_int(), cob_get_llint(), cob_move_binary_to_binary(), and cob_move_binary_to_display().

163 {
164  cob_s64_t n = 0;
165  size_t fsiz = 8U - f->size;
166 
167 #ifndef WORDS_BIGENDIAN
168  if (COB_FIELD_BINARY_SWAP (f)) {
169  if (COB_FIELD_HAVE_SIGN (f)) {
170  own_byte_memcpy ((unsigned char *)&n, f->data, f->size);
171  n = COB_BSWAP_64 (n);
172  /* Shift with sign */
173  n >>= 8 * fsiz;
174  } else {
175  own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
176  n = COB_BSWAP_64 (n);
177  }
178  } else {
179  if (COB_FIELD_HAVE_SIGN (f)) {
180  own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
181  /* Shift with sign */
182  n >>= 8 * fsiz;
183  } else {
184  own_byte_memcpy ((unsigned char *)&n, f->data, f->size);
185  }
186  }
187 #else /* WORDS_BIGENDIAN */
188  if (COB_FIELD_HAVE_SIGN (f)) {
189  own_byte_memcpy ((unsigned char *)&n, f->data, f->size);
190  /* Shift with sign */
191  n >>= 8 * fsiz;
192  } else {
193  own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
194  }
195 #endif /* WORDS_BIGENDIAN */
196  return n;
197 }
static COB_INLINE COB_A_INLINE cob_u64_t cob_binary_mget_uint64 ( const cob_field *const  f)
static

References COB_BSWAP_64, COB_FIELD_BINARY_SWAP, cob_u64_t, cob_field::data, own_byte_memcpy(), and cob_field::size.

Referenced by cob_move_binary_to_binary(), and cob_move_binary_to_display().

201 {
202  cob_u64_t n = 0;
203  size_t fsiz = 8U - f->size;
204 
205 #ifndef WORDS_BIGENDIAN
206  if (COB_FIELD_BINARY_SWAP (f)) {
207  own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
208  n = COB_BSWAP_64 (n);
209  } else {
210  own_byte_memcpy ((unsigned char *)&n, f->data, f->size);
211  }
212 #else /* WORDS_BIGENDIAN */
213  own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
214 #endif /* WORDS_BIGENDIAN */
215 
216  return n;
217 }
static COB_INLINE COB_A_INLINE void cob_binary_mset_sint64 ( cob_field *  f,
cob_s64_t  n 
)
static

References COB_BSWAP_64, COB_FIELD_BINARY_SWAP, cob_field::data, own_byte_memcpy(), and cob_field::size.

Referenced by cob_move_binary_to_binary(), and cob_move_display_to_binary().

221 {
222 #ifndef WORDS_BIGENDIAN
223  unsigned char *s;
224 
225  if (COB_FIELD_BINARY_SWAP (f)) {
226  n = COB_BSWAP_64 (n);
227  s = ((unsigned char *)&n) + 8 - f->size;
228  } else {
229  s = (unsigned char *)&n;
230  }
231  own_byte_memcpy (f->data, s, f->size);
232 #else /* WORDS_BIGENDIAN */
233  own_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size);
234 #endif /* WORDS_BIGENDIAN */
235 }
static COB_INLINE COB_A_INLINE void cob_binary_mset_uint64 ( cob_field *  f,
cob_u64_t  n 
)
static

References COB_BSWAP_64, COB_FIELD_BINARY_SWAP, cob_field::data, own_byte_memcpy(), and cob_field::size.

Referenced by cob_move_binary_to_binary(), and cob_move_display_to_binary().

239 {
240 #ifndef WORDS_BIGENDIAN
241  unsigned char *s;
242 
243  if (COB_FIELD_BINARY_SWAP (f)) {
244  n = COB_BSWAP_64 (n);
245  s = ((unsigned char *)&n) + 8 - f->size;
246  } else {
247  s = (unsigned char *)&n;
248  }
249  own_byte_memcpy (f->data, s, f->size);
250 #else /* WORDS_BIGENDIAN */
251  own_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size);
252 #endif /* WORDS_BIGENDIAN */
253 }
static int cob_display_get_int ( cob_field *  f)
static

References COB_D2I, cob_exp10, COB_FIELD_DATA, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_GET_SIGN, COB_PUT_SIGN, and sign.

Referenced by cob_get_int().

1534 {
1535  unsigned char *data;
1536  size_t size;
1537  size_t i;
1538  int val = 0;
1539  int sign;
1540 
1541  size = COB_FIELD_SIZE (f);
1542  data = COB_FIELD_DATA (f);
1543  sign = COB_GET_SIGN (f);
1544  /* Skip preceding zeros */
1545  for (i = 0; i < size; ++i) {
1546  if (COB_D2I (data[i]) != 0) {
1547  break;
1548  }
1549  }
1550 
1551  /* Get value */
1552  if (COB_FIELD_SCALE(f) < 0) {
1553  for (; i < size; ++i) {
1554  val = val * 10 + COB_D2I (data[i]);
1555  }
1556  val *= cob_exp10[(int)-COB_FIELD_SCALE(f)];
1557  } else {
1558  size -= COB_FIELD_SCALE(f);
1559  for (; i < size; ++i) {
1560  val = val * 10 + COB_D2I (data[i]);
1561  }
1562  }
1563  if (sign < 0) {
1564  val = -val;
1565  }
1566 
1567  COB_PUT_SIGN (f, sign);
1568  return val;
1569 }
static cob_s64_t cob_display_get_long_long ( cob_field *  f)
static

References COB_D2I, cob_exp10_ll, COB_FIELD_DATA, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_GET_SIGN, COB_PUT_SIGN, cob_s64_t, and sign.

Referenced by cob_get_llint().

1573 {
1574  unsigned char *data;
1575  size_t size;
1576  size_t i;
1577  cob_s64_t val = 0;
1578  int sign;
1579 
1580  size = COB_FIELD_SIZE (f);
1581  data = COB_FIELD_DATA (f);
1582  sign = COB_GET_SIGN (f);
1583  /* Skip preceding zeros */
1584  for (i = 0; i < size; ++i) {
1585  if (COB_D2I (data[i]) != 0) {
1586  break;
1587  }
1588  }
1589 
1590  /* Get value */
1591  if (COB_FIELD_SCALE(f) < 0) {
1592  for (; i < size; ++i) {
1593  val = val * 10 + COB_D2I (data[i]);
1594  }
1595  val *= cob_exp10_ll[(int)-COB_FIELD_SCALE(f)];
1596  } else {
1597  size -= COB_FIELD_SCALE(f);
1598  for (; i < size; ++i) {
1599  val = val * 10 + COB_D2I (data[i]);
1600  }
1601  }
1602  if (sign < 0) {
1603  val = -val;
1604  }
1605 
1606  COB_PUT_SIGN (f, sign);
1607  return val;
1608 }
int cob_get_int ( cob_field *  f)

References cob_field::attr, COB_ATTR_INIT, cob_binary_mget_sint64(), cob_display_get_int(), COB_FIELD_SCALE, COB_FIELD_TYPE, COB_FLAG_HAVE_SIGN, cob_move(), cob_packed_get_int(), cob_s64_t, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_PACKED, cob_field::data, NULL, and cob_field::size.

Referenced by cob_allocate(), cob_intr_char(), cob_intr_combined_datetime(), cob_intr_date_of_integer(), cob_intr_date_to_yyyymmdd(), cob_intr_day_of_integer(), cob_intr_day_to_yyyyddd(), cob_intr_factorial(), cob_intr_formatted_date(), cob_intr_formatted_datetime(), cob_intr_formatted_time(), cob_intr_integer_of_date(), cob_intr_integer_of_day(), cob_intr_lcl_time_from_secs(), cob_intr_locale_date(), cob_intr_locale_time(), cob_intr_random(), cob_intr_test_date_yyyymmdd(), cob_intr_test_day_yyyyddd(), cob_intr_year_to_yyyy(), cob_linage_write_opt(), cob_rewrite(), cob_start(), cob_string_init(), cob_sys_getopt_long_long(), cob_sys_parameter_size(), cob_sys_sleep(), cob_unstring_init(), cob_write(), file_linage_check(), relative_delete(), relative_read(), relative_rewrite(), relative_start(), relative_write(), and try_get_valid_offset_time().

1626 {
1627  int n;
1628  cob_s64_t val;
1629  cob_field temp;
1630  cob_field_attr attr;
1631 
1632  switch (COB_FIELD_TYPE (f)) {
1633  case COB_TYPE_NUMERIC_DISPLAY:
1634  return cob_display_get_int (f);
1635  case COB_TYPE_NUMERIC_PACKED:
1636  return cob_packed_get_int (f);
1637  case COB_TYPE_NUMERIC_BINARY:
1638  val = cob_binary_mget_sint64 (f);
1639  for (n = COB_FIELD_SCALE (f); n > 0 && val; --n) {
1640  val /= 10;
1641  }
1642  return (int)val;
1643  default:
1644  COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0,
1645  COB_FLAG_HAVE_SIGN, NULL);
1646  temp.size = 4;
1647  temp.data = (unsigned char *)&n;
1648  temp.attr = &attr;
1649  cob_move (f, &temp);
1650  return n;
1651  }
1652 }
cob_s64_t cob_get_llint ( cob_field *  f)

References cob_field::attr, cob_binary_mget_sint64(), cob_display_get_long_long(), COB_FIELD_SCALE, COB_FIELD_TYPE, cob_move(), cob_packed_get_long_long(), cob_s64_t, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_PACKED, const_binll_attr, cob_field::data, and cob_field::size.

Referenced by cob_sys_oc_nanosleep().

1656 {
1657  cob_s64_t n;
1658  int inc;
1659  cob_field temp;
1660 
1661  switch (COB_FIELD_TYPE (f)) {
1662  case COB_TYPE_NUMERIC_DISPLAY:
1663  return cob_display_get_long_long (f);
1664  case COB_TYPE_NUMERIC_PACKED:
1665  return cob_packed_get_long_long (f);
1666  case COB_TYPE_NUMERIC_BINARY:
1667  n = cob_binary_mget_sint64 (f);
1668  for (inc = COB_FIELD_SCALE (f); inc > 0 && n; --inc) {
1669  n /= 10;
1670  }
1671  return n;
1672  default:
1673  temp.size = 8;
1674  temp.data = (unsigned char *)&n;
1675  temp.attr = &const_binll_attr;
1676  cob_move (f, &temp);
1677  return n;
1678  }
1679 }
void cob_init_move ( cob_global *  lptr,
runtime_env *  runtimeptr 
)

References cob_check_env_true(), runtime_env::cob_local_edit, COB_UNUSED, and p.

Referenced by cob_init().

1683 {
1684 #if 0 /* RXWRXW - Local edit sym */
1685 #ifdef HAVE_LOCALECONV
1686  struct lconv *p;
1687  char *s;
1688 #endif
1689 #endif
1690 
1691  cobglobptr = lptr;
1692 
1693 #if 0 /* RXWRXW localeconv */
1694  cob_locale_edit = 0;
1695  cob_lc_dec = 0;
1696  cob_lc_thou = 0;
1697 #ifdef HAVE_LOCALECONV
1698  s = getenv ("COB_LOCALE_NUMERIC_EDITED");
1699  if (cob_check_env_true(s)) {
1700  p = localeconv ();
1701  if (strlen (p->mon_decimal_point) != 1) {
1702  return;
1703  }
1704  if (strlen (p->mon_thousands_sep) != 1) {
1705  return;
1706  }
1707  cob_locale_edit = 1;
1708  runtimeptr->cob_local_edit = &cob_local_edit;
1709  cob_lc_dec = *((unsigned char *)(p->mon_decimal_point));
1710  cob_lc_thou = *((unsigned char *)(p->mon_thousands_sep));
1711  }
1712 #else
1713  COB_UNUSED(runtimeptr);
1714 #endif
1715 #else
1716  COB_UNUSED(runtimeptr);
1717 #endif
1718 }
static COB_INLINE int cob_max_int ( const int  x,
const int  y 
)
static

Referenced by cob_move(), and store_common_region().

102 {
103  if (x > y) {
104  return x;
105  }
106  return y;
107 }
static COB_INLINE int cob_min_int ( const int  x,
const int  y 
)
static

Referenced by cob_move_display_to_alphanum(), and store_common_region().

93 {
94  if (x < y) {
95  return x;
96  }
97  return y;
98 }
void cob_move ( cob_field *  src,
cob_field *  dst 
)

References cob_field::attr, cob_decimal_move_temp(), cob_decimal_setget_fld(), COB_FIELD_BINARY_TRUNC, COB_FIELD_DIGITS, COB_FIELD_REAL_BINARY, COB_FIELD_SCALE, COB_FIELD_TYPE, COB_MAX_DIGITS, cob_max_int(), cob_move_all(), cob_move_alphanum_to_alphanum(), cob_move_alphanum_to_display(), cob_move_alphanum_to_edited(), cob_move_binary_to_binary(), cob_move_binary_to_display(), cob_move_display_to_alphanum(), cob_move_display_to_binary(), cob_move_display_to_display(), cob_move_display_to_edited(), cob_move_display_to_packed(), cob_move_edited_to_display(), cob_move_fp_to_fp(), cob_move_packed_to_display(), COB_STORE_TRUNC_ON_OVERFLOW, COB_TYPE_ALPHANUMERIC_ALL, COB_TYPE_ALPHANUMERIC_EDITED, COB_TYPE_GROUP, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_EDITED, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_BIN128, COB_TYPE_NUMERIC_FP_BIN32, COB_TYPE_NUMERIC_FP_BIN64, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_L_DOUBLE, COB_TYPE_NUMERIC_PACKED, const_alpha_attr, cob_field::data, indirect_move(), cob_field::size, and unlikely.

Referenced by cob_accept(), cob_accept_arg_number(), cob_allocate(), cob_cmp(), cob_decimal_get_field(), cob_decimal_move_temp(), cob_display_arg_number(), cob_get_indirect_field(), cob_get_int(), cob_get_llint(), cob_memcpy(), cob_move_all(), cob_set_int(), cob_str_memcpy(), display_numeric(), indirect_move(), and pretty_display_numeric().

1170 {
1171  int opt;
1172  cob_field temp;
1173  unsigned char data[4];
1174 
1175  if (src == dst) {
1176  return;
1177  }
1178  if (dst->size == 0) {
1179  return;
1180  }
1181  if (unlikely(src->size == 0)) {
1182  temp.size = 1;
1183  temp.data = data;
1184  temp.attr = &const_alpha_attr;
1185  data[0] = ' ';
1186  data[1] = 0;
1187  src = &temp;
1188  }
1189  if (COB_FIELD_TYPE (src) == COB_TYPE_ALPHANUMERIC_ALL) {
1190  cob_move_all (src, dst);
1191  return;
1192  }
1193 
1194  /* Non-elementary move */
1195  if (COB_FIELD_TYPE (src) == COB_TYPE_GROUP ||
1196  COB_FIELD_TYPE (dst) == COB_TYPE_GROUP) {
1197  cob_move_alphanum_to_alphanum (src, dst);
1198  return;
1199  }
1200 
1201  opt = 0;
1202  if (COB_FIELD_TYPE (dst) == COB_TYPE_NUMERIC_BINARY) {
1203  if (COB_FIELD_BINARY_TRUNC (dst) &&
1204  !COB_FIELD_REAL_BINARY(dst)) {
1205  opt = COB_STORE_TRUNC_ON_OVERFLOW;
1206  }
1207  }
1208 
1209  /* Elementary move */
1210  switch (COB_FIELD_TYPE (src)) {
1211  case COB_TYPE_NUMERIC_DISPLAY:
1212  switch (COB_FIELD_TYPE (dst)) {
1213  case COB_TYPE_NUMERIC_FLOAT:
1214  case COB_TYPE_NUMERIC_DOUBLE:
1215  case COB_TYPE_NUMERIC_L_DOUBLE:
1216  case COB_TYPE_NUMERIC_FP_BIN32:
1217  case COB_TYPE_NUMERIC_FP_BIN64:
1218  case COB_TYPE_NUMERIC_FP_BIN128:
1219  case COB_TYPE_NUMERIC_FP_DEC64:
1220  case COB_TYPE_NUMERIC_FP_DEC128:
1221  cob_decimal_setget_fld (src, dst, 0);
1222  return;
1223  case COB_TYPE_NUMERIC_DISPLAY:
1224  cob_move_display_to_display (src, dst);
1225  return;
1226  case COB_TYPE_NUMERIC_PACKED:
1227  cob_move_display_to_packed (src, dst);
1228  return;
1229  case COB_TYPE_NUMERIC_BINARY:
1230  cob_move_display_to_binary (src, dst);
1231  return;
1232  case COB_TYPE_NUMERIC_EDITED:
1233  cob_move_display_to_edited (src, dst);
1234  return;
1235  case COB_TYPE_ALPHANUMERIC_EDITED:
1236  if (COB_FIELD_SCALE(src) < 0 ||
1237  COB_FIELD_SCALE(src) > COB_FIELD_DIGITS(src)) {
1238  /* Expand P's */
1239  indirect_move (cob_move_display_to_display, src, dst,
1240  (size_t)cob_max_int ((int)COB_FIELD_DIGITS(src), (int)COB_FIELD_SCALE(src)),
1241  cob_max_int (0, (int)COB_FIELD_SCALE(src)));
1242  return;
1243  } else {
1244  cob_move_alphanum_to_edited (src, dst);
1245  return;
1246  }
1247  default:
1248  cob_move_display_to_alphanum (src, dst);
1249  return;
1250  }
1251 
1252  case COB_TYPE_NUMERIC_PACKED:
1253  switch (COB_FIELD_TYPE (dst)) {
1254  case COB_TYPE_NUMERIC_DISPLAY:
1255  cob_move_packed_to_display (src, dst);
1256  return;
1257  case COB_TYPE_NUMERIC_BINARY:
1258  cob_decimal_setget_fld (src, dst, opt);
1259  return;
1260  case COB_TYPE_NUMERIC_PACKED:
1261  case COB_TYPE_NUMERIC_DOUBLE:
1262  case COB_TYPE_NUMERIC_FLOAT:
1263  case COB_TYPE_NUMERIC_L_DOUBLE:
1264  case COB_TYPE_NUMERIC_FP_BIN32:
1265  case COB_TYPE_NUMERIC_FP_BIN64:
1266  case COB_TYPE_NUMERIC_FP_BIN128:
1267  case COB_TYPE_NUMERIC_FP_DEC64:
1268  case COB_TYPE_NUMERIC_FP_DEC128:
1269  cob_decimal_setget_fld (src, dst, 0);
1270  return;
1271  default:
1272  indirect_move (cob_move_packed_to_display, src, dst,
1273  (size_t)(COB_FIELD_DIGITS(src)),
1274  COB_FIELD_SCALE(src));
1275  return;
1276  }
1277 
1278  case COB_TYPE_NUMERIC_BINARY:
1279  switch (COB_FIELD_TYPE (dst)) {
1280  case COB_TYPE_NUMERIC_BINARY:
1281  if (COB_FIELD_SCALE(src) == COB_FIELD_SCALE(dst)) {
1282  cob_move_binary_to_binary (src, dst);
1283  return;
1284  }
1285  cob_decimal_setget_fld (src, dst, opt);
1286  return;
1287  case COB_TYPE_NUMERIC_DISPLAY:
1288  cob_move_binary_to_display (src, dst);
1289  return;
1290  case COB_TYPE_NUMERIC_PACKED:
1291  case COB_TYPE_NUMERIC_DOUBLE:
1292  case COB_TYPE_NUMERIC_FLOAT:
1293  case COB_TYPE_NUMERIC_L_DOUBLE:
1294  case COB_TYPE_NUMERIC_FP_BIN32:
1295  case COB_TYPE_NUMERIC_FP_BIN64:
1296  case COB_TYPE_NUMERIC_FP_BIN128:
1297  case COB_TYPE_NUMERIC_FP_DEC64:
1298  case COB_TYPE_NUMERIC_FP_DEC128:
1299  cob_decimal_setget_fld (src, dst, 0);
1300  return;
1301  case COB_TYPE_NUMERIC_EDITED:
1302  indirect_move (cob_move_binary_to_display, src, dst,
1303  (size_t)COB_MAX_DIGITS,
1304  COB_FIELD_SCALE(src));
1305  return;
1306  default:
1307  indirect_move (cob_move_binary_to_display, src, dst,
1308  (size_t)(COB_FIELD_DIGITS(src)),
1309  COB_FIELD_SCALE(src));
1310  return;
1311  }
1312 
1313  case COB_TYPE_NUMERIC_EDITED:
1314  switch (COB_FIELD_TYPE (dst)) {
1315  case COB_TYPE_NUMERIC_DISPLAY:
1316  cob_move_edited_to_display (src, dst);
1317  return;
1318  case COB_TYPE_NUMERIC_PACKED:
1319  case COB_TYPE_NUMERIC_BINARY:
1320  case COB_TYPE_NUMERIC_EDITED:
1321  case COB_TYPE_NUMERIC_FLOAT:
1322  case COB_TYPE_NUMERIC_DOUBLE:
1323  case COB_TYPE_NUMERIC_L_DOUBLE:
1324  case COB_TYPE_NUMERIC_FP_BIN32:
1325  case COB_TYPE_NUMERIC_FP_BIN64:
1326  case COB_TYPE_NUMERIC_FP_BIN128:
1327  case COB_TYPE_NUMERIC_FP_DEC64:
1328  case COB_TYPE_NUMERIC_FP_DEC128:
1329  indirect_move (cob_move_edited_to_display, src, dst,
1330  (size_t)(2 * COB_MAX_DIGITS),
1331  COB_MAX_DIGITS);
1332  return;
1333  case COB_TYPE_ALPHANUMERIC_EDITED:
1334  cob_move_alphanum_to_edited (src, dst);
1335  return;
1336  default:
1337  cob_move_alphanum_to_alphanum (src, dst);
1338  return;
1339  }
1340 
1341  case COB_TYPE_NUMERIC_DOUBLE:
1342  switch (COB_FIELD_TYPE (dst)) {
1343  case COB_TYPE_NUMERIC_DOUBLE:
1344  memmove (dst->data, src->data, sizeof(double));
1345  return;
1346  case COB_TYPE_NUMERIC_FLOAT:
1347  cob_move_fp_to_fp (src, dst);
1348  return;
1349  case COB_TYPE_NUMERIC_BINARY:
1350  cob_decimal_setget_fld (src, dst, opt);
1351  return;
1352  case COB_TYPE_NUMERIC_PACKED:
1353  case COB_TYPE_NUMERIC_DISPLAY:
1354  case COB_TYPE_NUMERIC_L_DOUBLE:
1355  case COB_TYPE_NUMERIC_FP_BIN32:
1356  case COB_TYPE_NUMERIC_FP_BIN64:
1357  case COB_TYPE_NUMERIC_FP_BIN128:
1358  case COB_TYPE_NUMERIC_FP_DEC64:
1359  case COB_TYPE_NUMERIC_FP_DEC128:
1360  cob_decimal_setget_fld (src, dst, 0);
1361  return;
1362  default:
1363  cob_decimal_move_temp (src, dst);
1364  return;
1365  }
1366 
1367  case COB_TYPE_NUMERIC_FLOAT:
1368  switch (COB_FIELD_TYPE (dst)) {
1369  case COB_TYPE_NUMERIC_FLOAT:
1370  memmove (dst->data, src->data, sizeof(float));
1371  return;
1372  case COB_TYPE_NUMERIC_DOUBLE:
1373  cob_move_fp_to_fp (src, dst);
1374  return;
1375  case COB_TYPE_NUMERIC_BINARY:
1376  cob_decimal_setget_fld (src, dst, opt);
1377  return;
1378  case COB_TYPE_NUMERIC_PACKED:
1379  case COB_TYPE_NUMERIC_DISPLAY:
1380  case COB_TYPE_NUMERIC_L_DOUBLE:
1381  case COB_TYPE_NUMERIC_FP_BIN32:
1382  case COB_TYPE_NUMERIC_FP_BIN64:
1383  case COB_TYPE_NUMERIC_FP_BIN128:
1384  case COB_TYPE_NUMERIC_FP_DEC64:
1385  case COB_TYPE_NUMERIC_FP_DEC128:
1386  cob_decimal_setget_fld (src, dst, 0);
1387  return;
1388  default:
1389  cob_decimal_move_temp (src, dst);
1390  return;
1391  }
1392 
1393  case COB_TYPE_NUMERIC_FP_DEC64:
1394  switch (COB_FIELD_TYPE (dst)) {
1395  case COB_TYPE_NUMERIC_BINARY:
1396  cob_decimal_setget_fld (src, dst, opt);
1397  return;
1398  case COB_TYPE_NUMERIC_FP_DEC64:
1399  memmove (dst->data, src->data, (size_t)8);
1400  return;
1401  case COB_TYPE_NUMERIC_FLOAT:
1402  case COB_TYPE_NUMERIC_DOUBLE:
1403  case COB_TYPE_NUMERIC_PACKED:
1404  case COB_TYPE_NUMERIC_DISPLAY:
1405  case COB_TYPE_NUMERIC_L_DOUBLE:
1406  case COB_TYPE_NUMERIC_FP_BIN32:
1407  case COB_TYPE_NUMERIC_FP_BIN128:
1408  case COB_TYPE_NUMERIC_FP_DEC128:
1409  cob_decimal_setget_fld (src, dst, 0);
1410  return;
1411  default:
1412  cob_decimal_move_temp (src, dst);
1413  return;
1414  }
1415  case COB_TYPE_NUMERIC_FP_DEC128:
1416  switch (COB_FIELD_TYPE (dst)) {
1417  case COB_TYPE_NUMERIC_BINARY:
1418  cob_decimal_setget_fld (src, dst, opt);
1419  return;
1420  case COB_TYPE_NUMERIC_FP_DEC128:
1421  memmove (dst->data, src->data, (size_t)16);
1422  return;
1423  case COB_TYPE_NUMERIC_FLOAT:
1424  case COB_TYPE_NUMERIC_DOUBLE:
1425  case COB_TYPE_NUMERIC_PACKED:
1426  case COB_TYPE_NUMERIC_DISPLAY:
1427  case COB_TYPE_NUMERIC_L_DOUBLE:
1428  case COB_TYPE_NUMERIC_FP_BIN32:
1429  case COB_TYPE_NUMERIC_FP_BIN64:
1430  case COB_TYPE_NUMERIC_FP_BIN128:
1431  case COB_TYPE_NUMERIC_FP_DEC64:
1432  cob_decimal_setget_fld (src, dst, 0);
1433  return;
1434  default:
1435  cob_decimal_move_temp (src, dst);
1436  return;
1437  }
1438  default:
1439  switch (COB_FIELD_TYPE (dst)) {
1440  case COB_TYPE_NUMERIC_DISPLAY:
1441  cob_move_alphanum_to_display (src, dst);
1442  return;
1443  case COB_TYPE_NUMERIC_PACKED:
1444  case COB_TYPE_NUMERIC_BINARY:
1445  case COB_TYPE_NUMERIC_EDITED:
1446  case COB_TYPE_NUMERIC_FLOAT:
1447  case COB_TYPE_NUMERIC_DOUBLE:
1448  case COB_TYPE_NUMERIC_L_DOUBLE:
1449  case COB_TYPE_NUMERIC_FP_BIN32:
1450  case COB_TYPE_NUMERIC_FP_BIN64:
1451  case COB_TYPE_NUMERIC_FP_BIN128:
1452  case COB_TYPE_NUMERIC_FP_DEC64:
1453  case COB_TYPE_NUMERIC_FP_DEC128:
1454  indirect_move (cob_move_alphanum_to_display, src, dst,
1455  (size_t)(2* COB_MAX_DIGITS),
1456  COB_MAX_DIGITS);
1457  return;
1458  case COB_TYPE_ALPHANUMERIC_EDITED:
1459  cob_move_alphanum_to_edited (src, dst);
1460  return;
1461  default:
1462  cob_move_alphanum_to_alphanum (src, dst);
1463  return;
1464  }
1465  }
1466 }
static void cob_move_all ( cob_field *  src,
cob_field *  dst 
)
static

References cob_field::attr, COB_ATTR_INIT, COB_FIELD_IS_ALNUM, COB_FIELD_IS_NUMERIC, cob_free(), cob_malloc(), COB_MAX_DIGITS, cob_move(), COB_TYPE_ALPHANUMERIC, COB_TYPE_NUMERIC_DISPLAY, cob_field::data, cob_field_attr::digits, likely, NULL, p, cob_field::size, and cob_field_attr::type.

Referenced by cob_move().

1126 {
1127  unsigned char *p;
1128  size_t i;
1129  size_t digcount;
1130  cob_field temp;
1131  cob_field_attr attr;
1132 
1133  if (likely(COB_FIELD_IS_ALNUM(dst))) {
1134  if (likely(src->size == 1)) {
1135  memset (dst->data, src->data[0], dst->size);
1136  } else {
1137  digcount = src->size;
1138  for (i = 0; i < dst->size; ++i) {
1139  dst->data[i] = src->data[i % digcount];
1140  }
1141  }
1142  return;
1143  }
1144  COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
1145  if (COB_FIELD_IS_NUMERIC(dst)) {
1146  digcount = COB_MAX_DIGITS;
1147  attr.type = COB_TYPE_NUMERIC_DISPLAY;
1148  attr.digits = COB_MAX_DIGITS;
1149  } else {
1150  digcount = dst->size;
1151  }
1152  p = cob_malloc (digcount);
1153  temp.size = digcount;
1154  temp.data = p;
1155  temp.attr = &attr;
1156  if (likely(src->size == 1)) {
1157  memset (p, src->data[0], digcount);
1158  } else {
1159  for (i = 0; i < digcount; ++i) {
1160  p[i] = src->data[i % src->size];
1161  }
1162  }
1163 
1164  cob_move (&temp, dst);
1165  cob_free (p);
1166 }
static void cob_move_alphanum_to_alphanum ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_JUSTIFIED, cob_field::data, and cob_field::size.

Referenced by cob_move().

418 {
419  unsigned char *data1;
420  unsigned char *data2;
421  size_t size1;
422  size_t size2;
423 
424  data1 = f1->data;
425  size1 = f1->size;
426  data2 = f2->data;
427  size2 = f2->size;
428  if (size1 >= size2) {
429  /* Move string with truncation */
430  if (COB_FIELD_JUSTIFIED (f2)) {
431  memmove (data2, data1 + size1 - size2, size2);
432  } else {
433  memmove (data2, data1, size2);
434  }
435  } else {
436  /* Move string with padding */
437  if (COB_FIELD_JUSTIFIED (f2)) {
438  memset (data2, ' ', size2 - size1);
439  memmove (data2 + size2 - size1, data1, size1);
440  } else {
441  memmove (data2, data1, size1);
442  memset (data2 + size1, ' ', size2 - size1);
443  }
444  }
445 }
static void cob_move_alphanum_to_display ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_DATA, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_MODULE_PTR, COB_PUT_SIGN, cob_field::data, p, sign, and cob_field::size.

Referenced by cob_move().

259 {
260  unsigned char *p;
261  unsigned char *s1;
262  unsigned char *s2;
263  unsigned char *e1;
264  unsigned char *e2;
265  int sign;
266  int count;
267  int size;
268  unsigned char c;
269  unsigned char dec_pt;
270  unsigned char num_sep;
271 
272  /* Initialize */
273  s1 = f1->data;
274  e1 = s1 + f1->size;
275  s2 = COB_FIELD_DATA (f2);
276  e2 = s2 + COB_FIELD_SIZE (f2);
277  memset (f2->data, '0', f2->size);
278 
279  /* Skip white spaces */
280  for (; s1 < e1; ++s1) {
281  if (!isspace (*s1)) {
282  break;
283  }
284  }
285 
286  /* Check for sign */
287  sign = 0;
288  if (s1 != e1) {
289  if (*s1 == '+' || *s1 == '-') {
290  sign = (*s1++ == '+') ? 1 : -1;
291  }
292  }
293 
294  dec_pt = COB_MODULE_PTR->decimal_point;
295  num_sep = COB_MODULE_PTR->numeric_separator;
296 
297  /* Count the number of digits before decimal point */
298  count = 0;
299  for (p = s1; p < e1 && *p != dec_pt; ++p) {
300  if (isdigit (*p)) {
301  ++count;
302  }
303  }
304 
305  /* Find the start position */
306  size = (int) COB_FIELD_SIZE (f2) - COB_FIELD_SCALE(f2);
307  if (count < size) {
308  s2 += size - count;
309  } else {
310  while (count-- > size) {
311  while (!isdigit (*s1++)) {
312  ;
313  }
314  }
315  }
316 
317  /* Move */
318  count = 0;
319  for (; s1 < e1 && s2 < e2; ++s1) {
320  c = *s1;
321  if (isdigit (c)) {
322  *s2++ = c;
323  } else if (c == dec_pt) {
324  if (count++ > 0) {
325  goto error;
326  }
327  } else if (!(isspace (c) || c == num_sep)) {
328  goto error;
329  }
330  }
331 
332  COB_PUT_SIGN (f2, sign);
333  return;
334 
335 error:
336  memset (f2->data, '0', f2->size);
337  COB_PUT_SIGN (f2, 0);
338 }
static void cob_move_alphanum_to_edited ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_DATA, COB_FIELD_PIC, COB_FIELD_SIZE, COB_GET_SIGN, COB_PUT_SIGN, cob_field::data, p, and sign.

Referenced by cob_move().

1065 {
1066  const char *p;
1067  unsigned char *max;
1068  unsigned char *src;
1069  unsigned char *dst;
1070  int sign;
1071  int n;
1072  unsigned char c;
1073 
1074  sign = COB_GET_SIGN (f1);
1075  src = COB_FIELD_DATA (f1);
1076  max = src + COB_FIELD_SIZE (f1);
1077  dst = f2->data;
1078  for (p = COB_FIELD_PIC (f2); *p;) {
1079  c = *p++; /* PIC char */
1080  memcpy ((void *)&n, p, sizeof(int)); /* PIC char count */
1081  p += sizeof(int);
1082  for (; n > 0; --n) {
1083  switch (c) {
1084  case 'A':
1085  case 'X':
1086  case '9':
1087  *dst++ = (src < max) ? *src++ : ' ';
1088  break;
1089  case '0':
1090  case '/':
1091  *dst++ = c;
1092  break;
1093  case 'B':
1094  *dst++ = ' ';
1095  break;
1096  default:
1097  *dst++ = '?'; /* Invalid PIC */
1098  }
1099  }
1100  }
1101  COB_PUT_SIGN (f1, sign);
1102 }
static void cob_move_binary_to_binary ( cob_field *  f1,
cob_field *  f2 
)
static

References cob_binary_mget_sint64(), cob_binary_mget_uint64(), cob_binary_mset_sint64(), cob_binary_mset_uint64(), COB_FIELD_HAVE_SIGN, cob_s64_t, cob_u64_t, and sign.

Referenced by cob_move().

564 {
565  union {
566  cob_u64_t val;
567  cob_s64_t val2;
568  } ul64;
569  unsigned int sign;
570 
571  sign = 0;
572  if (COB_FIELD_HAVE_SIGN (f1)) {
573  ul64.val2 = cob_binary_mget_sint64 (f1);
574  if (ul64.val2 < 0) {
575  sign = 1;
576  }
577  } else {
578  ul64.val = cob_binary_mget_uint64 (f1);
579  }
580  if (COB_FIELD_HAVE_SIGN (f2)) {
581  cob_binary_mset_sint64 (f2, ul64.val2);
582  } else {
583  if (sign) {
584  cob_binary_mset_uint64 (f2, (cob_u64_t)(-ul64.val2));
585  } else {
586  cob_binary_mset_uint64 (f2, ul64.val);
587  }
588  }
589 }
static void cob_move_binary_to_display ( cob_field *  f1,
cob_field *  f2 
)
static

References cob_binary_mget_sint64(), cob_binary_mget_uint64(), COB_FIELD_HAVE_SIGN, COB_FIELD_SCALE, COB_I2D, COB_PUT_SIGN, cob_s64_t, cob_u64_t, cob_u8_ptr, sign, and store_common_region().

Referenced by cob_move().

637 {
638  cob_u64_t val;
639  cob_s64_t val2;
640  int i;
641  int sign;
642  char buff[32];
643 
644  sign = 1;
645  /* Get value */
646  if (COB_FIELD_HAVE_SIGN (f1)) {
647  val2 = cob_binary_mget_sint64 (f1);
648  if (val2 < 0) {
649  sign = -1;
650  val = (cob_u64_t)-val2;
651  } else {
652  val = (cob_u64_t)val2;
653  }
654  } else {
655  val = cob_binary_mget_uint64 (f1);
656  }
657 
658  /* Convert to string */
659  i = 20;
660  while (val > 0) {
661  buff[--i] = (char) COB_I2D (val % 10);
662  val /= 10;
663  }
664 
665  /* Store */
666  store_common_region (f2, (cob_u8_ptr)buff + i, (size_t)(20 - i),
667  COB_FIELD_SCALE(f1));
668 
669  COB_PUT_SIGN (f2, sign);
670 }
static void cob_move_display_to_alphanum ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_DATA, COB_FIELD_JUSTIFIED, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_GET_SIGN, cob_min_int(), COB_PUT_SIGN, cob_field::data, sign, cob_field::size, and unlikely.

Referenced by cob_move().

355 {
356  unsigned char *data1;
357  unsigned char *data2;
358  size_t size1;
359  size_t size2;
360  int sign;
361  int diff;
362  int zero_size;
363 
364  data1 = COB_FIELD_DATA (f1);
365  size1 = COB_FIELD_SIZE (f1);
366  sign = COB_GET_SIGN (f1);
367  if (unlikely(COB_FIELD_SCALE(f1) < 0)) {
368  /* Scaling */
369  zero_size = (int)-COB_FIELD_SCALE(f1);
370  } else {
371  zero_size = 0;
372  }
373  data2 = f2->data;
374  size2 = f2->size;
375  if (unlikely(COB_FIELD_JUSTIFIED (f2))) {
376  /* Justified right */
377  if (zero_size) {
378  /* Implied 0 ('P's) */
379  zero_size = cob_min_int (zero_size, (int)size2);
380  size2 -= zero_size;
381  memset (data2 + size2, '0', (size_t) zero_size);
382  }
383  if (size2) {
384  diff = (int)(size2 - size1);
385  if (diff > 0) {
386  /* Padding */
387  memset (data2, ' ', (size_t)diff);
388  data2 += diff;
389  size2 -= diff;
390  }
391  memmove (data2, data1 + size1 - size2, size2);
392  }
393  } else {
394  diff = (int)(size2 - size1);
395  if (diff < 0) {
396  memmove (data2, data1, size2);
397  } else {
398  memmove (data2, data1, size1);
399  if (zero_size) {
400  /* Implied 0 ('P's) */
401  zero_size = cob_min_int (zero_size, diff);
402  memset (data2 + size1, '0', (size_t)zero_size);
403  diff -= zero_size;
404  }
405  if (diff) {
406  /* Padding */
407  memset (data2 + size1 + zero_size, ' ',
408  (size_t)diff);
409  }
410  }
411  }
412 
413  COB_PUT_SIGN (f1, sign);
414 }
static void cob_move_display_to_binary ( cob_field *  f1,
cob_field *  f2 
)
static

References cob_binary_mset_sint64(), cob_binary_mset_uint64(), COB_D2I, cob_exp10_ll, COB_FIELD_BINARY_TRUNC, COB_FIELD_DATA, COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, COB_FIELD_REAL_BINARY, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_GET_SIGN, COB_PUT_SIGN, cob_s64_t, cob_u64_t, and sign.

Referenced by cob_move().

593 {
594  unsigned char *data1;
595  cob_u64_t val;
596  cob_s64_t val2;
597  size_t i, size;
598  size_t size1;
599  int sign;
600 
601  size1 = COB_FIELD_SIZE (f1);
602  data1 = COB_FIELD_DATA (f1);
603  sign = COB_GET_SIGN (f1);
604  /* Get value */
605  val = 0;
606  size = size1 - COB_FIELD_SCALE(f1) + COB_FIELD_SCALE(f2);
607  for (i = 0; i < size; ++i) {
608  if (val) {
609  val *= 10;
610  }
611  if (i < size1) {
612  val += COB_D2I (data1[i]);
613  }
614  }
615 
616  if (COB_FIELD_BINARY_TRUNC (f2) &&
617  !COB_FIELD_REAL_BINARY(f2)) {
618  val %= cob_exp10_ll[(int)COB_FIELD_DIGITS(f2)];
619  }
620 
621  if (COB_FIELD_HAVE_SIGN (f2)) {
622  if (sign < 0) {
623  val2 = -(cob_s64_t)val;
624  } else {
625  val2 = val;
626  }
627  cob_binary_mset_sint64 (f2, val2);
628  } else {
629  cob_binary_mset_uint64 (f2, val);
630  }
631 
632  COB_PUT_SIGN (f1, sign);
633 }
static void cob_move_display_to_display ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_DATA, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_GET_SIGN, COB_PUT_SIGN, sign, and store_common_region().

Referenced by cob_move().

342 {
343  int sign;
344 
345  sign = COB_GET_SIGN (f1);
346  store_common_region (f2, COB_FIELD_DATA (f1), COB_FIELD_SIZE (f1),
347  COB_FIELD_SCALE (f1));
348 
349  COB_PUT_SIGN (f1, sign);
350  COB_PUT_SIGN (f2, sign);
351 }
static void cob_move_display_to_edited ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_BLANK_ZERO, COB_FIELD_DATA, COB_FIELD_PIC, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_GET_SIGN, COB_MODULE_PTR, COB_PUT_SIGN, cob_field::data, NULL, p, sign, and cob_field::size.

Referenced by cob_move().

676 {
677  const char *p;
678  unsigned char *min;
679  unsigned char *max;
680  unsigned char *src;
681  unsigned char *dst;
682  unsigned char *end;
683  unsigned char *decimal_point;
684  int sign;
685  int neg;
686  int count;
687  int count_sign;
688  int count_curr;
689  int trailing_sign;
690  int trailing_curr;
691  int is_zero;
692  int suppress_zero;
693  int sign_first;
694  int p_is_left;
695  int repeat;
696  int n;
697  unsigned char pad;
698  unsigned char x;
699  unsigned char c;
700  unsigned char sign_symbol;
701  unsigned char curr_symbol;
702  unsigned char dec_symbol;
703  unsigned char currency;
704 
705  decimal_point = NULL;
706  count = 0;
707  count_sign = 1;
708  count_curr = 1;
709  trailing_sign = 0;
710  trailing_curr = 0;
711  is_zero = 1;
712  suppress_zero = 1;
713  sign_first = 0;
714  p_is_left = 0;
715  pad = ' ';
716  sign_symbol = 0;
717  curr_symbol = 0;
718 
719  currency = COB_MODULE_PTR->currency_symbol;
720 
721  if (COB_MODULE_PTR->decimal_point == ',') {
722  dec_symbol = ',';
723  } else {
724  dec_symbol = '.';
725  }
726 
727  sign = COB_GET_SIGN (f1);
728  neg = (sign < 0) ? 1 : 0;
729  /* Count the number of digit places before decimal point */
730  for (p = COB_FIELD_PIC (f2); *p; p += 5) {
731  c = p[0];
732  memmove ((unsigned char *)&repeat, p + 1, sizeof(int));
733  if (c == '9' || c == 'Z' || c == '*') {
734  count += repeat;
735  count_sign = 0;
736  count_curr = 0;
737  } else if (count_curr && c == currency) {
738  count += repeat;
739  } else if (count_sign && (c == '+' || c == '-')) {
740  count += repeat;
741  } else if (c == 'P') {
742  if (count == 0) {
743  p_is_left = 1;
744  break;
745  } else {
746  count += repeat;
747  count_sign = 0;
748  count_curr = 0;
749  }
750  } else if (c == 'V' || c == dec_symbol) {
751  break;
752  }
753  }
754 
755  min = COB_FIELD_DATA (f1);
756  max = min + COB_FIELD_SIZE (f1);
757  src = max - COB_FIELD_SCALE(f1) - count;
758  dst = f2->data;
759  end = f2->data + f2->size;
760  for (p = COB_FIELD_PIC (f2); *p;) {
761  c = *p++; /* PIC char */
762  memmove ((void *)&n, p, sizeof(int)); /* PIC char count */
763  p += sizeof(int);
764  for (; n > 0; n--, ++dst) {
765  switch (c) {
766  case '0':
767  case '/':
768  *dst = c;
769  break;
770 
771  case 'B':
772  *dst = suppress_zero ? pad : 'B';
773  break;
774 
775  case 'P':
776  if (p_is_left) {
777  ++src;
778  --dst;
779  }
780  break;
781 
782  case '9':
783  *dst = (min <= src && src < max) ? *src++ : (src++, '0');
784  if (*dst != '0') {
785  is_zero = suppress_zero = 0;
786  }
787  suppress_zero = 0;
788  trailing_sign = 1;
789  trailing_curr = 1;
790  break;
791 
792  case 'V':
793  --dst;
794  decimal_point = dst;
795  break;
796 
797  case '.':
798  case ',':
799  if (c == dec_symbol) {
800  *dst = dec_symbol;
801  decimal_point = dst;
802  } else {
803  if (suppress_zero) {
804  *dst = pad;
805  } else {
806  *dst = c;
807  }
808  }
809  break;
810 
811  case 'C':
812  case 'D':
813  end = dst;
814  /* Check negative and not zero */
815  if (neg && !is_zero) {
816  if (c == 'C') {
817  memcpy (dst, "CR", (size_t)2);
818  } else {
819  memcpy (dst, "DB", (size_t)2);
820  }
821  } else {
822  memset (dst, ' ', (size_t)2);
823  }
824  dst++;
825  break;
826 
827  case 'Z':
828  case '*':
829  x = (min <= src && src < max) ? *src++ : (src++, '0');
830  if (x != '0') {
831  is_zero = suppress_zero = 0;
832  }
833  pad = (c == '*') ? '*' : ' ';
834  *dst = suppress_zero ? pad : x;
835  trailing_sign = 1;
836  trailing_curr = 1;
837  break;
838 
839  case '+':
840  case '-':
841  x = (min <= src && src < max) ? *src++ : (src++, '0');
842  if (x != '0') {
843  is_zero = suppress_zero = 0;
844  }
845  if (trailing_sign) {
846  /* Check negative and not zero */
847  if (neg && !is_zero) {
848  *dst = '-';
849  } else if (c == '+') {
850  *dst = '+';
851  } else {
852  *dst = ' ';
853  }
854  --end;
855  } else if (dst == f2->data || suppress_zero) {
856  *dst = pad;
857  sign_symbol = c;
858  if (!curr_symbol) {
859  ++sign_first;
860  }
861  } else {
862  *dst = x;
863  }
864  break;
865 
866  default:
867  if (c == currency) {
868  x = (min <= src && src < max) ? *src++ : (src++, '0');
869  if (x != '0') {
870  is_zero = suppress_zero = 0;
871  }
872  if (trailing_curr) {
873  *dst = currency;
874  --end;
875  } else if (dst == f2->data || suppress_zero) {
876  *dst = pad;
877  curr_symbol = currency;
878  } else {
879  *dst = x;
880  }
881  break;
882  }
883 
884  *dst = '?'; /* Invalid PIC */
885  }
886  }
887  }
888 
889  if (sign_symbol) {
890  /* Check negative and not zero */
891  if (neg && !is_zero) {
892  sign_symbol = '-';
893  } else if (sign_symbol != '+') {
894  sign_symbol = ' ';
895  }
896  }
897 
898  if (suppress_zero || (is_zero && COB_FIELD_BLANK_ZERO (f2))) {
899  /* All digits are zeros */
900  if (pad == ' ' || COB_FIELD_BLANK_ZERO (f2)) {
901  memset (f2->data, ' ', f2->size);
902  } else {
903  for (dst = f2->data; dst < f2->data + f2->size; ++dst) {
904  if (*dst != dec_symbol) {
905  *dst = pad;
906  }
907  }
908  }
909  } else {
910  /* Put zero after the decimal point if necessary */
911  if (decimal_point) {
912  for (dst = decimal_point + 1; dst < end; ++dst) {
913  switch (*dst) {
914  case '0':
915  case '1':
916  case '2':
917  case '3':
918  case '4':
919  case '5':
920  case '6':
921  case '7':
922  case '8':
923  case '9':
924  case ',':
925  case '+':
926  case '-':
927  case '/':
928  case 'B':
929  break;
930  default:
931  *dst = '0';
932  }
933  }
934  }
935 
936  /* Put sign or currency symbol at the beginning */
937  if (sign_symbol || curr_symbol) {
938  for (dst = end - 1; dst > f2->data; --dst) {
939  if (*dst == ' ') {
940  break;
941  }
942  }
943  if (sign_symbol && curr_symbol) {
944  if (sign_first) {
945  *dst = curr_symbol;
946  --dst;
947  if (dst >= f2->data) {
948  *dst = sign_symbol;
949  }
950  } else {
951  *dst = sign_symbol;
952  --dst;
953  if (dst >= f2->data) {
954  *dst = curr_symbol;
955  }
956  }
957  } else if (sign_symbol) {
958  *dst = sign_symbol;
959  } else {
960  *dst = curr_symbol;
961  }
962  }
963 
964  /* Replace all 'B's by pad */
965  count = 0;
966  for (dst = f2->data; dst < end; ++dst) {
967  if (*dst == 'B') {
968  if (count == 0) {
969  *dst = pad;
970  } else {
971  *dst = ' ';
972  }
973  } else {
974  ++count;
975  }
976  }
977  }
978 
979  COB_PUT_SIGN (f1, sign);
980 }
static void cob_move_display_to_packed ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_D2I, COB_FIELD_DATA, COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_SCALE, COB_GET_SIGN, COB_PUT_SIGN, cob_field::data, p, sign, and cob_field::size.

Referenced by cob_move().

451 {
452  unsigned char *data1;
453  unsigned char *data2;
454  unsigned char *p;
455  size_t digits1;
456  size_t digits2;
457  size_t i;
458  size_t offset;
459  int sign;
460  int scale1;
461  int scale2;
462  unsigned char n;
463 
464  sign = COB_GET_SIGN (f1);
465  data1 = COB_FIELD_DATA (f1);
466  digits1 = COB_FIELD_DIGITS (f1);
467  scale1 = COB_FIELD_SCALE (f1);
468  data2 = f2->data;
469  digits2 = COB_FIELD_DIGITS (f2);
470  scale2 = COB_FIELD_SCALE (f2);
471 
472  /* Pack string */
473  memset (f2->data, 0, f2->size);
474  if (COB_FIELD_NO_SIGN_NIBBLE (f2)) {
475  offset = digits2 % 2;
476  } else {
477  offset = 1 - (digits2 % 2);
478  }
479  p = data1 + (digits1 - scale1) - (digits2 - scale2);
480  for (i = offset; i < digits2 + offset; ++i, ++p) {
481  n = (data1 <= p && p < data1 + digits1 && *p != ' ') ?
482  COB_D2I (*p) : 0;
483  if (i % 2 == 0) {
484  data2[i / 2] = n << 4;
485  } else {
486  data2[i / 2] |= n;
487  }
488  }
489 
490  COB_PUT_SIGN (f1, sign);
491  if (COB_FIELD_NO_SIGN_NIBBLE (f2)) {
492  return;
493  }
494  p = f2->data + f2->size - 1;
495  if (!COB_FIELD_HAVE_SIGN (f2)) {
496  *p = (*p & 0xF0) | 0x0F;
497  } else if (sign < 0) {
498  *p = (*p & 0xF0) | 0x0D;
499  } else {
500  *p = (*p & 0xF0) | 0x0C;
501  }
502 }
static void cob_move_edited_to_display ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_PIC, cob_free(), cob_malloc(), COB_MODULE_PTR, COB_PUT_SIGN, cob_field::data, p, sign, cob_field::size, and store_common_region().

Referenced by cob_move().

984 {
985  unsigned char *p;
986  unsigned char *buff;
987  const char *p1;
988  size_t i;
989  int sign = 0;
990  int scale = 0;
991  int count = 0;
992  int have_point = 0;
993  int n;
994  unsigned char c;
995  unsigned char cp;
996  unsigned char dec_pt;
997 
998  dec_pt = COB_MODULE_PTR->decimal_point;
999  buff = cob_malloc (f1->size);
1000  p = buff;
1001  /* De-edit */
1002  for (i = 0; i < f1->size; ++i) {
1003  cp = f1->data[i];
1004  switch (cp) {
1005  case '0':
1006  case '1':
1007  case '2':
1008  case '3':
1009  case '4':
1010  case '5':
1011  case '6':
1012  case '7':
1013  case '8':
1014  case '9':
1015  *p++ = cp;
1016  if (have_point) {
1017  ++scale;
1018  }
1019  break;
1020  case '.':
1021  case ',':
1022  if (cp == dec_pt) {
1023  have_point = 1;
1024  }
1025  break;
1026  case '-':
1027  case 'C':
1028  sign = -1;
1029  break;
1030  }
1031  }
1032  /* Count number of digit places after decimal point in case of 'V', 'P' */
1033  if (scale == 0) {
1034  for (p1 = COB_FIELD_PIC (f1); *p1; p1 += 5) {
1035  c = p1[0];
1036  memmove ((void *)&n, p1 + 1, sizeof(int));
1037  if (c == '9' || c == '0' || c == 'Z' || c == '*') {
1038  if (have_point) {
1039  scale += n;
1040  } else {
1041  count += n;
1042  }
1043  } else if (c == 'P') {
1044  if (count == 0) {
1045  have_point = 1;
1046  scale += n;
1047  } else {
1048  scale -= n;
1049  }
1050  } else if (c == 'V') {
1051  have_point = 1;
1052  }
1053  }
1054  }
1055 
1056  /* Store */
1057  store_common_region (f2, buff, (size_t)(p - buff), scale);
1058 
1059  COB_PUT_SIGN (f2, sign);
1060  cob_free (buff);
1061 }
static void cob_move_fp_to_fp ( cob_field *  src,
cob_field *  dst 
)
static

References COB_FIELD_TYPE, COB_TYPE_NUMERIC_FLOAT, and cob_field::data.

Referenced by cob_move().

541 {
542  double dfp;
543  float ffp;
544 
545  if (COB_FIELD_TYPE (src) == COB_TYPE_NUMERIC_FLOAT) {
546  memmove ((void *)&ffp, src->data, sizeof(float));
547  dfp = (double)ffp;
548  } else {
549  memmove ((void *)&dfp, src->data, sizeof(double));
550  ffp = (float)dfp;
551  }
552  if (COB_FIELD_TYPE (dst) == COB_TYPE_NUMERIC_FLOAT) {
553  memmove (dst->data, (void *)&ffp, sizeof(float));
554  } else {
555  memmove (dst->data, (void *)&dfp, sizeof(double));
556  }
557 }
static void cob_move_packed_to_display ( cob_field *  f1,
cob_field *  f2 
)
static

References COB_FIELD_DIGITS, COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_SCALE, COB_I2D, cob_packed_get_sign(), COB_PUT_SIGN, cob_field::data, sign, and store_common_region().

Referenced by cob_move().

506 {
507  unsigned char *data;
508  size_t i;
509  size_t offset;
510  int sign;
511  unsigned char buff[256];
512 
513  /* Unpack string */
514  data = f1->data;
515  if (COB_FIELD_NO_SIGN_NIBBLE (f1)) {
516  sign = 0;
517  offset = COB_FIELD_DIGITS(f1) % 2;
518  } else {
519  sign = cob_packed_get_sign (f1);
520  offset = 1 - (COB_FIELD_DIGITS(f1) % 2);
521  }
522  for (i = offset; i < COB_FIELD_DIGITS(f1) + offset; ++i) {
523  if (i % 2 == 0) {
524  buff[i - offset] = COB_I2D (data[i / 2] >> 4);
525  } else {
526  buff[i - offset] = COB_I2D (data[i / 2] & 0x0F);
527  }
528  }
529 
530  /* Store */
531  store_common_region (f2, buff, (size_t)COB_FIELD_DIGITS (f1),
532  COB_FIELD_SCALE (f1));
533 
534  COB_PUT_SIGN (f2, sign);
535 }
static int cob_packed_get_int ( cob_field *  f1)
static

References COB_FIELD_DIGITS, COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_SCALE, cob_packed_get_sign(), cob_field::data, and sign.

Referenced by cob_get_int().

1472 {
1473  unsigned char *data;
1474  size_t i;
1475  size_t offset;
1476  int val = 0;
1477  int sign;
1478 
1479  data = f1->data;
1480  if (COB_FIELD_NO_SIGN_NIBBLE (f1)) {
1481  sign = 0;
1482  offset = COB_FIELD_DIGITS(f1) % 2;
1483  } else {
1484  sign = cob_packed_get_sign (f1);
1485  offset = 1 - (COB_FIELD_DIGITS(f1) % 2);
1486  }
1487  for (i = offset; i < COB_FIELD_DIGITS(f1) - COB_FIELD_SCALE(f1) + offset; ++i) {
1488  val *= 10;
1489  if (i % 2 == 0) {
1490  val += data[i / 2] >> 4;
1491  } else {
1492  val += data[i / 2] & 0x0F;
1493  }
1494  }
1495  if (sign < 0) {
1496  val = -val;
1497  }
1498  return val;
1499 }
static cob_s64_t cob_packed_get_long_long ( cob_field *  f1)
static

References COB_FIELD_DIGITS, COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_SCALE, cob_packed_get_sign(), cob_s64_t, cob_field::data, and sign.

Referenced by cob_get_llint().

1503 {
1504  unsigned char *data;
1505  size_t i;
1506  size_t offset;
1507  cob_s64_t val = 0;
1508  int sign;
1509 
1510  data = f1->data;
1511  if (COB_FIELD_NO_SIGN_NIBBLE (f1)) {
1512  sign = 0;
1513  offset = COB_FIELD_DIGITS(f1) % 2;
1514  } else {
1515  sign = cob_packed_get_sign (f1);
1516  offset = 1 - (COB_FIELD_DIGITS(f1) % 2);
1517  }
1518  for (i = offset; i < COB_FIELD_DIGITS(f1) - COB_FIELD_SCALE(f1) + offset; ++i) {
1519  val *= 10;
1520  if (i % 2 == 0) {
1521  val += data[i / 2] >> 4;
1522  } else {
1523  val += data[i / 2] & 0x0F;
1524  }
1525  }
1526  if (sign < 0) {
1527  val = -val;
1528  }
1529  return val;
1530 }
static int cob_packed_get_sign ( const cob_field *  f)
static

References COB_FIELD_HAVE_SIGN, cob_field::data, p, and cob_field::size.

Referenced by cob_move_packed_to_display(), cob_packed_get_int(), and cob_packed_get_long_long().

119 {
120  unsigned char *p;
121 
122  if (!COB_FIELD_HAVE_SIGN (f)) {
123  return 0;
124  }
125  p = f->data + f->size - 1;
126  return ((*p & 0x0F) == 0x0D) ? -1 : 1;
127 }
void cob_set_int ( cob_field *  f,
const int  n 
)

References cob_field::attr, COB_ATTR_INIT, COB_FLAG_HAVE_SIGN, COB_FLAG_REAL_BINARY, cob_move(), COB_TYPE_NUMERIC_BINARY, cob_field::data, NULL, and cob_field::size.

Referenced by cob_accept(), cob_accept_escape_key(), cob_accept_exception_status(), cob_file_open(), cob_linage_write_opt(), cob_read(), cob_read_next(), cob_screen_line_col(), cob_string_finish(), cob_sys_chdir(), cob_sys_getopt_long_long(), cob_sys_return_args(), cob_unstring_finish(), cob_unstring_into(), file_linage_check(), relative_read_next(), relative_start(), and relative_write().

1612 {
1613  cob_field temp;
1614  cob_field_attr attr;
1615 
1616  COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0,
1617  COB_FLAG_HAVE_SIGN | COB_FLAG_REAL_BINARY, NULL);
1618  temp.size = 4;
1619  temp.data = (unsigned char *)&n;
1620  temp.attr = &attr;
1621  cob_move (&temp, f);
1622 }
static void indirect_move ( void(*)(cob_field *src, cob_field *dst)  func,
cob_field *  src,
cob_field *  dst,
const size_t  size,
const int  scale 
)
static

References cob_field::attr, COB_ATTR_INIT, COB_FLAG_HAVE_SIGN, cob_free(), cob_malloc(), cob_move(), COB_TYPE_NUMERIC_DISPLAY, cob_field::data, NULL, and cob_field::size.

Referenced by cob_move().

1110 {
1111  cob_field temp;
1112  cob_field_attr attr;
1113 
1114  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, size, scale,
1115  COB_FLAG_HAVE_SIGN, NULL);
1116  temp.size = size;
1117  temp.data = cob_malloc (size);
1118  temp.attr = &attr;
1119  func (src, &temp);
1120  cob_move (&temp, dst);
1121  cob_free (temp.data);
1122 }
static COB_INLINE COB_A_INLINE void own_byte_memcpy ( unsigned char *  s1,
const unsigned char *  s2,
size_t  size 
)
static

Referenced by cob_binary_mget_sint64(), cob_binary_mget_uint64(), cob_binary_mset_sint64(), and cob_binary_mset_uint64().

111 {
112  do {
113  *s1++ = *s2++;
114  } while (--size);
115 }
static void store_common_region ( cob_field *  f,
const unsigned char *  data,
const size_t  size,
const int  scale 
)
static

References COB_FIELD_DATA, COB_FIELD_SCALE, COB_FIELD_SIZE, cob_max_int(), cob_min_int(), p, and unlikely.

Referenced by cob_move_binary_to_display(), cob_move_display_to_display(), cob_move_edited_to_display(), and cob_move_packed_to_display().

132 {
133  const unsigned char *p;
134  unsigned char *q;
135  size_t csize;
136  size_t cinc;
137  int lf1 = -scale;
138  int lf2 = -COB_FIELD_SCALE (f);
139  int hf1 = (int) size + lf1;
140  int hf2 = (int) COB_FIELD_SIZE (f) + lf2;
141  int lcf;
142  int gcf;
143 
144  lcf = cob_max_int (lf1, lf2);
145  gcf = cob_min_int (hf1, hf2);
146  memset (COB_FIELD_DATA (f), '0', COB_FIELD_SIZE (f));
147  if (gcf > lcf) {
148  csize = (size_t)(gcf - lcf);
149  p = data + hf1 - gcf;
150  q = COB_FIELD_DATA (f) + hf2 - gcf;
151  for (cinc = 0; cinc < csize; ++cinc, ++p, ++q) {
152  if (unlikely(*p == ' ' || *p == 0)) {
153  *q = (unsigned char)'0';
154  } else {
155  *q = *p;
156  }
157  }
158  }
159 }

Variable Documentation

const int cob_exp10[10]
static
Initial value:
= {
1,
10,
100,
1000,
10000,
100000,
1000000,
10000000,
100000000,
1000000000
}

Referenced by cob_display_get_int().

const cob_s64_t cob_exp10_ll[19]
static
Initial value:
= {
COB_S64_C(1),
COB_S64_C(10),
COB_S64_C(100),
COB_S64_C(1000),
COB_S64_C(10000),
COB_S64_C(100000),
COB_S64_C(1000000),
COB_S64_C(10000000),
COB_S64_C(100000000),
COB_S64_C(1000000000),
COB_S64_C(10000000000),
COB_S64_C(100000000000),
COB_S64_C(1000000000000),
COB_S64_C(10000000000000),
COB_S64_C(100000000000000),
COB_S64_C(1000000000000000),
COB_S64_C(10000000000000000),
COB_S64_C(100000000000000000),
}

Referenced by cob_display_get_long_long(), and cob_move_display_to_binary().

cob_global* cobglobptr
static
const cob_field_attr const_alpha_attr
static
Initial value:
=
{COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}

Referenced by cob_move().

const cob_field_attr const_binll_attr
static
Initial value:
=
{COB_TYPE_NUMERIC_BINARY, 20, 0,
COB_FLAG_HAVE_SIGN, NULL}

Referenced by cob_get_llint().