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

Macros

#define _GNU_SOURCE   1
 
#define COB_LIB_EXPIMP
 
#define DECIMAL_CHECK(d1, d2)
 
#define TOLERANCE   (double) 0.0000001
 
#define FLOAT_EQ(x, y, t)   (fabs(((x-y)/x)) < t)
 

Functions

void cob_gmp_free (void *ptr)
 
static COB_INLINE COB_A_INLINE void num_byte_memcpy (unsigned char *s1, const unsigned char *s2, size_t size)
 
static COB_INLINE COB_A_INLINE
cob_s64_t 		cob_binary_get_sint64 (const cob_field *const f)
 
static COB_INLINE COB_A_INLINE
cob_u64_t 		cob_binary_get_uint64 (const cob_field *const f)
 
static COB_INLINE COB_A_INLINE void cob_binary_set_uint64 (cob_field *f, cob_u64_t n)
 
static COB_INLINE COB_A_INLINE void cob_binary_set_int64 (cob_field *f, cob_s64_t n)
 
void cob_decimal_init (cob_decimal *d)
 
void cob_decimal_set_llint (cob_decimal *d, const cob_s64_t n)
 
static COB_INLINE COB_A_INLINE void cob_decimal_set (cob_decimal *dst, const cob_decimal *src)
 
static void cob_decimal_print (cob_decimal *d, FILE *fp)
 
static void shift_decimal (cob_decimal *d, const int n)
 
static void align_decimal (cob_decimal *d1, cob_decimal *d2)
 
static int cob_decimal_get_ieee64dec (cob_decimal *d, cob_field *f, const int opt)
 
static void cob_decimal_set_ieee64dec (cob_decimal *d, const cob_field *f)
 
static int cob_decimal_get_ieee128dec (cob_decimal *d, cob_field *f, const int opt)
 
static void cob_decimal_set_ieee128dec (cob_decimal *d, const cob_field *f)
 
static void cob_decimal_set_double (cob_decimal *d, const double v)
 
static double cob_decimal_get_double (cob_decimal *d)
 
static int cob_packed_get_sign (const cob_field *f)
 
void cob_set_packed_zero (cob_field *f)
 
static void cob_decimal_set_packed (cob_decimal *d, cob_field *f)
 
static int cob_decimal_get_packed (cob_decimal *d, cob_field *f, const int opt)
 
void cob_set_packed_int (cob_field *f, const int val)
 
static void cob_decimal_set_display (cob_decimal *d, cob_field *f)
 
static int cob_decimal_get_display (cob_decimal *d, cob_field *f, const int opt)
 
static void cob_decimal_set_binary (cob_decimal *d, cob_field *f)
 
static int cob_decimal_get_binary (cob_decimal *d, cob_field *f, const int opt)
 
void cob_decimal_set_field (cob_decimal *d, cob_field *f)
 
void cob_print_ieeedec (const cob_field *f, FILE *fp)
 
void cob_print_realbin (const cob_field *f, FILE *fp, const int size)
 
static void cob_decimal_do_round (cob_decimal *d, cob_field *f, const int opt)
 
int cob_decimal_get_field (cob_decimal *d, cob_field *f, const int opt)
 
void cob_decimal_add (cob_decimal *d1, cob_decimal *d2)
 
void cob_decimal_sub (cob_decimal *d1, cob_decimal *d2)
 
void cob_decimal_mul (cob_decimal *d1, cob_decimal *d2)
 
void cob_decimal_div (cob_decimal *d1, cob_decimal *d2)
 
int cob_decimal_cmp (cob_decimal *d1, cob_decimal *d2)
 
void cob_add (cob_field *f1, cob_field *f2, const int opt)
 
void cob_sub (cob_field *f1, cob_field *f2, const int opt)
 
void cob_mul (cob_field *f1, cob_field *f2, const int opt)
 
void cob_div (cob_field *f1, cob_field *f2, const int opt)
 
void cob_div_quotient (cob_field *dividend, cob_field *divisor, cob_field *quotient, const int opt)
 
void cob_div_remainder (cob_field *fld_remainder, const int opt)
 
void cob_decimal_setget_fld (cob_field *src, cob_field *dst, const int opt)
 
int cob_add_int (cob_field *f, const int n, const int opt)
 
int cob_sub_int (cob_field *f, const int n, const int opt)
 
int cob_cmp_int (cob_field *f1, const int n)
 
int cob_cmp_uint (cob_field *f1, const unsigned int n)
 
int cob_cmp_llint (cob_field *f1, const cob_s64_t n)
 
int cob_cmp_float (cob_field *f1, cob_field *f2)
 
int cob_numeric_cmp (cob_field *f1, cob_field *f2)
 
int cob_cmp_packed (cob_field *f, const cob_s64_t val)
 
static unsigned int cob_get_long_ebcdic_sign (const unsigned char *p, cob_s64_t *val)
 
int cob_cmp_numdisp (const unsigned char *data, const size_t size, const cob_s64_t n, const cob_u32_t has_sign)
 
void cob_decimal_alloc (const cob_u32_t params,...)
 
void cob_decimal_push (const cob_u32_t params,...)
 
void cob_decimal_pop (const cob_u32_t params,...)
 
void cob_exit_numeric (void)
 
void cob_init_numeric (cob_global *lptr)
 

Variables

static cob_global * cobglobptr
 
static const unsigned char packed_bytes []
 
static cob_decimal cob_d1
 
static cob_decimal cob_d2
 
static cob_decimal cob_d3
 
static cob_decimal cob_d_remainder
 
static cob_decimal * cob_decimal_base
 
static mpz_t cob_mexp
 
static mpz_t cob_mpzt
 
static mpz_t cob_mpzt2
 
static mpz_t cob_mpz_ten34m1
 
static mpz_t cob_mpz_ten16m1
 
static mpz_t cob_mpze10 [COB_MAX_BINARY]
 
static mpf_t cob_mpft
 
static mpf_t cob_mpft_get
 
static unsigned char packed_value [20]
 
static cob_u64_t last_packed_val
 

Macro Definition Documentation

#define _GNU_SOURCE   1
#define COB_LIB_EXPIMP
#define DECIMAL_CHECK (   d1,
  d2 
)
Value:
if (unlikely(d1->scale == COB_DECIMAL_NAN || \
d2->scale == COB_DECIMAL_NAN)) { \
d1->scale = COB_DECIMAL_NAN; \
return; \
}

Referenced by cob_decimal_add(), cob_decimal_div(), cob_decimal_mul(), and cob_decimal_sub().

#define FLOAT_EQ (   x,
  y,
  t 
)    (fabs(((x-y)/x)) < t)

Referenced by cob_cmp_float().

#define TOLERANCE   (double) 0.0000001

Referenced by cob_cmp_float().

Function Documentation

static void align_decimal ( cob_decimal *  d1,
cob_decimal *  d2 
)
static

References cob_decimal::scale, and shift_decimal().

Referenced by cob_decimal_add(), cob_decimal_cmp(), and cob_decimal_sub().

412 {
413  if (d1->scale < d2->scale) {
414  shift_decimal (d1, d2->scale - d1->scale);
415  } else if (d1->scale > d2->scale) {
416  shift_decimal (d2, d1->scale - d2->scale);
417  }
418 }
void cob_add ( cob_field *  f1,
cob_field *  f2,
const int  opt 
)

References cob_decimal_add(), cob_decimal_get_field(), and cob_decimal_set_field().

1932 {
1933  cob_decimal_set_field (&cob_d1, f1);
1934  cob_decimal_set_field (&cob_d2, f2);
1935  cob_decimal_add (&cob_d1, &cob_d2);
1936  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1937 }
int cob_add_int ( cob_field *  f,
const int  n,
const int  opt 
)

References cob_decimal_get_field(), cob_decimal_set_field(), COB_FIELD_SCALE, COB_FIELD_TYPE, cob_mexp, cob_sli_t, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_BIN128, COB_TYPE_NUMERIC_PACKED, cob_uli_t, cob_decimal::scale, unlikely, and cob_decimal::value.

Referenced by cob_inspect_characters(), cob_linage_write_opt(), cob_sub_int(), cob_unstring_tallying(), inspect_common(), and relative_read_next().

2196 {
2197  int scale;
2198  int val;
2199 
2200  if (unlikely(n == 0)) {
2201  return 0;
2202  }
2203 #if 0 /* RXWRXW - Buggy */
2204  if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_PACKED) {
2205  return cob_add_packed (f, n, opt);
2206  } else if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_DISPLAY) {
2207  return cob_display_add_int (f, n, opt);
2208  }
2209 #endif
2210 
2211  /* Not optimized */
2212  cob_decimal_set_field (&cob_d1, f);
2213 
2214  if (COB_FIELD_TYPE (f) >= COB_TYPE_NUMERIC_FLOAT
2215  && COB_FIELD_TYPE (f) <= COB_TYPE_NUMERIC_FP_BIN128) {
2216  mpz_set_si (cob_d2.value, (cob_sli_t) n);
2217  cob_d2.scale = 0;
2218  mpz_add (cob_d1.value, cob_d1.value, cob_d2.value);
2219  return cob_decimal_get_field (&cob_d1, f, opt);
2220  }
2221  else {
2222  scale = COB_FIELD_SCALE (f);
2223  val = n;
2224  if (unlikely(scale < 0)) {
2225  /* PIC 9(n)P(m) */
2226  if (-scale < 10) {
2227  while (scale++) {
2228  val /= 10;
2229  }
2230  } else {
2231  val = 0;
2232  }
2233  scale = 0;
2234  if (!val) {
2235  return 0;
2236  }
2237  }
2238  mpz_set_si (cob_d2.value, (cob_sli_t)val);
2239  cob_d2.scale = 0;
2240  if (scale > 0) {
2241  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)scale);
2242  mpz_mul (cob_d2.value, cob_d2.value, cob_mexp);
2243  cob_d2.scale = cob_d1.scale;
2244  }
2245  mpz_add (cob_d1.value, cob_d1.value, cob_d2.value);
2246  return cob_decimal_get_field (&cob_d1, f, opt);
2247  }
2248 }
static COB_INLINE COB_A_INLINE cob_s64_t cob_binary_get_sint64 ( const cob_field *const  f)
static

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

Referenced by cob_decimal_set_binary(), and cob_print_realbin().

238 {
239  cob_s64_t n = 0;
240  size_t fsiz = 8U - f->size;
241 
242 #ifndef WORDS_BIGENDIAN
243  if (COB_FIELD_BINARY_SWAP (f)) {
244  num_byte_memcpy ((unsigned char *)&n, f->data, f->size);
245  n = COB_BSWAP_64 (n);
246  /* Shift with sign */
247  n >>= 8 * fsiz;
248  } else {
249  num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
250  /* Shift with sign */
251  n >>= 8 * fsiz;
252  }
253 #else /* WORDS_BIGENDIAN */
254  num_byte_memcpy ((unsigned char *)&n, f->data, f->size);
255  /* Shift with sign */
256  n >>= 8 * fsiz;
257 #endif /* WORDS_BIGENDIAN */
258 
259  return n;
260 }
static COB_INLINE COB_A_INLINE cob_u64_t cob_binary_get_uint64 ( const cob_field *const  f)
static

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

Referenced by cob_decimal_set_binary().

264 {
265  cob_u64_t n = 0;
266  size_t fsiz = 8U - f->size;
267 
268 #ifndef WORDS_BIGENDIAN
269  if (COB_FIELD_BINARY_SWAP (f)) {
270  num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
271  n = COB_BSWAP_64 (n);
272  } else {
273  num_byte_memcpy ((unsigned char *)&n, f->data, f->size);
274  }
275 #else /* WORDS_BIGENDIAN */
276  num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size);
277 #endif /* WORDS_BIGENDIAN */
278 
279  return n;
280 }
static COB_INLINE COB_A_INLINE void cob_binary_set_int64 ( cob_field *  f,
cob_s64_t  n 
)
static

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

Referenced by cob_decimal_get_binary().

302 {
303 #ifndef WORDS_BIGENDIAN
304  unsigned char *s;
305 
306  if (COB_FIELD_BINARY_SWAP (f)) {
307  n = COB_BSWAP_64 (n);
308  s = ((unsigned char *)&n) + 8 - f->size;
309  } else {
310  s = (unsigned char *)&n;
311  }
312  num_byte_memcpy (f->data, s, f->size);
313 #else /* WORDS_BIGENDIAN */
314  num_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size);
315 #endif /* WORDS_BIGENDIAN */
316 }
static COB_INLINE COB_A_INLINE void cob_binary_set_uint64 ( cob_field *  f,
cob_u64_t  n 
)
static

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

Referenced by cob_decimal_get_binary().

284 {
285 #ifndef WORDS_BIGENDIAN
286  unsigned char *s;
287 
288  if (COB_FIELD_BINARY_SWAP (f)) {
289  n = COB_BSWAP_64 (n);
290  s = ((unsigned char *)&n) + 8 - f->size;
291  } else {
292  s = (unsigned char *)&n;
293  }
294  num_byte_memcpy (f->data, s, f->size);
295 #else /* WORDS_BIGENDIAN */
296  num_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size);
297 #endif /* WORDS_BIGENDIAN */
298 }
int cob_cmp_float ( cob_field *  f1,
cob_field *  f2 
)

References cob_decimal_get_double(), cob_decimal_set_field(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, d1, d2, cob_field::data, FLOAT_EQ, and TOLERANCE.

Referenced by cob_numeric_cmp().

2312 {
2313  double d1,d2;
2314  float flt;
2315  if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_FLOAT) {
2316  memcpy(&flt,f1->data,sizeof(float));
2317  d1 = flt;
2318  } else if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_DOUBLE) {
2319  memcpy(&d1,f1->data,sizeof(double));
2320  } else {
2321  cob_decimal_set_field (&cob_d1, f1);
2322  d1 = cob_decimal_get_double(&cob_d1);
2323  }
2324  if(COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_FLOAT) {
2325  memcpy(&flt,f2->data,sizeof(float));
2326  d2 = flt;
2327  } else if(COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_DOUBLE) {
2328  memcpy(&d2,f2->data,sizeof(double));
2329  } else {
2330  cob_decimal_set_field (&cob_d1, f2);
2331  d2 = cob_decimal_get_double(&cob_d1);
2332  }
2333  if(d1 == d2)
2334  return 0;
2335  if(d1 != 0.0
2336  && FLOAT_EQ(d1,d2,TOLERANCE))
2337  return 0;
2338  if(d1 < d2)
2339  return -1;
2340  return 1;
2341 }
int cob_cmp_int ( cob_field *  f1,
const int  n 
)

References cob_decimal_cmp(), cob_decimal_set_field(), cob_sli_t, cob_decimal::scale, and cob_decimal::value.

Referenced by cob_cmp().

2258 {
2259  cob_decimal_set_field (&cob_d1, f1);
2260  mpz_set_si (cob_d2.value, (cob_sli_t)n);
2261  cob_d2.scale = 0;
2262  return cob_decimal_cmp (&cob_d1, &cob_d2);
2263 }
int cob_cmp_llint ( cob_field *  f1,
const cob_s64_t  n 
)

References cob_decimal_cmp(), cob_decimal_set_field(), cob_sli_t, cob_u32_t, cob_u64_t, cob_uli_t, cob_decimal::scale, and cob_decimal::value.

2276 {
2277 #ifdef COB_LI_IS_LL
2278  mpz_set_si (cob_d2.value, (cob_sli_t)n);
2279 #else
2280  cob_u64_t uval;
2281  cob_u32_t negative;
2282 
2283  negative = 0;
2284  if (n < 0) {
2285  negative = 1;
2286  uval = (cob_u64_t)-n;
2287  } else {
2288  uval = (cob_u64_t)n;
2289  }
2290  mpz_set_ui (cob_d2.value, (cob_uli_t)(uval >> 32));
2291  mpz_mul_2exp (cob_d2.value, cob_d2.value, 32);
2292  mpz_add_ui (cob_d2.value, cob_d2.value, (cob_uli_t)(uval & 0xFFFFFFFFU));
2293  if (negative) {
2294  mpz_neg (cob_d2.value, cob_d2.value);
2295  }
2296 #endif
2297 
2298  cob_d2.scale = 0;
2299  cob_decimal_set_field (&cob_d1, f1);
2300  return cob_decimal_cmp (&cob_d1, &cob_d2);
2301 }
int cob_cmp_numdisp ( const unsigned char *  data,
const size_t  size,
const cob_s64_t  n,
const cob_u32_t  has_sign 
)

References COB_D2I, cob_get_long_ebcdic_sign(), COB_MODULE_PTR, cob_s64_t, p, and unlikely.

2541 {
2542  const unsigned char *p;
2543  cob_s64_t val = 0;
2544  size_t inc;
2545 
2546  p = data;
2547  if (!has_sign) {
2548  if (unlikely(n < 0)) {
2549  return 1;
2550  }
2551  for (inc = 0; inc < size; inc++, p++) {
2552  val = (val * 10) + COB_D2I (*p);
2553  }
2554  return (val < n) ? -1 : (val > n);
2555  }
2556  for (inc = 0; inc < size - 1; inc++, p++) {
2557  val = (val * 10) + COB_D2I (*p);
2558  }
2559  val *= 10;
2560  if (*p >= (unsigned char)'0' && *p <= (unsigned char)'9') {
2561  val += COB_D2I (*p);
2562  } else {
2563  if (unlikely(COB_MODULE_PTR->ebcdic_sign)) {
2564  if (cob_get_long_ebcdic_sign (p, &val)) {
2565  val = -val;
2566  }
2567  } else {
2568 #ifdef COB_EBCDIC_MACHINE
2569  if (cob_get_long_ascii_sign (p, &val)) {
2570  val = -val;
2571  }
2572 #else
2573  if (*p >= (unsigned char)'p' && *p <= (unsigned char)'y') {
2574  val += (*p - (unsigned char)'p');
2575  val = -val;
2576  }
2577 #endif
2578  }
2579  }
2580  return (val < n) ? -1 : (val > n);
2581 }
int cob_cmp_packed ( cob_field *  f,
const cob_s64_t  val 
)

References COB_FIELD_DIGITS, COB_FIELD_NO_SIGN_NIBBLE, cob_packed_get_sign(), cob_u64_t, cob_field::data, last_packed_val, p, packed_value, sign, and cob_field::size.

2359 {
2360  unsigned char *p;
2361  cob_u64_t n;
2362  size_t size;
2363  size_t inc;
2364  int sign;
2365  unsigned char val1[20];
2366 
2367  sign = cob_packed_get_sign (f);
2368  /* Field positive, value negative */
2369  if (sign >= 0 && val < 0) {
2370  return 1;
2371  }
2372  /* Field negative, value positive */
2373  if (sign < 0 && val >= 0) {
2374  return -1;
2375  }
2376  /* Both positive or both negative */
2377  if (val < 0) {
2378  n = (cob_u64_t)-val;
2379  } else {
2380  n = (cob_u64_t)val;
2381  }
2382  inc = 0;
2383  p = f->data;
2384  for (size = 0; size < 20; size++) {
2385  if (size < 20 - f->size) {
2386  val1[size] = 0;
2387  } else {
2388  val1[size] = p[inc++];
2389  }
2390  }
2391  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
2392  if ((COB_FIELD_DIGITS(f) % 2) == 1) {
2393  val1[20 - f->size] &= 0x0F;
2394  }
2395  } else {
2396  val1[19] &= 0xF0;
2397  if ((COB_FIELD_DIGITS(f) % 2) == 0) {
2398  val1[20 - f->size] &= 0x0F;
2399  }
2400  }
2401  if (n != last_packed_val) {
2402  last_packed_val = n;
2403  memset (packed_value, 0, sizeof(packed_value));
2404  if (n) {
2405  p = &packed_value[19];
2406  if (!COB_FIELD_NO_SIGN_NIBBLE (f)) {
2407  *p = (n % 10) << 4;
2408  p--;
2409  n /= 10;
2410  }
2411  for (; n;) {
2412  size = n % 100;
2413  *p = (unsigned char)((size % 10) | ((size / 10) << 4));
2414  n /= 100;
2415  p--;
2416  }
2417  }
2418  }
2419  for (size = 0; size < 20; size++) {
2420  if (val1[size] != packed_value[size]) {
2421  if (sign < 0) {
2422  return packed_value[size] - val1[size];
2423  } else {
2424  return val1[size] - packed_value[size];
2425  }
2426  }
2427  }
2428  return 0;
2429 }
int cob_cmp_uint ( cob_field *  f1,
const unsigned int  n 
)

References cob_decimal_cmp(), cob_decimal_set_field(), cob_uli_t, cob_decimal::scale, and cob_decimal::value.

2267 {
2268  cob_decimal_set_field (&cob_d1, f1);
2269  mpz_set_ui (cob_d2.value, (cob_uli_t)n);
2270  cob_d2.scale = 0;
2271  return cob_decimal_cmp (&cob_d1, &cob_d2);
2272 }
void cob_decimal_add ( cob_decimal *  d1,
cob_decimal *  d2 
)

References align_decimal(), DECIMAL_CHECK, and cob_decimal::value.

Referenced by cob_add(), cob_intr_annuity(), cob_intr_binop(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_present_value(), cob_intr_standard_deviation(), cob_intr_sum(), and cob_intr_variance().

1876 {
1877  DECIMAL_CHECK (d1, d2);
1878  align_decimal (d1, d2);
1879  mpz_add (d1->value, d1->value, d2->value);
1880 }
void cob_decimal_alloc ( const cob_u32_t  params,
  ... 
)

References cob_u32_t, and params.

2585 {
2586  cob_decimal **dec;
2587  cob_u32_t i;
2588  va_list args;
2589 
2590  va_start (args, params);
2591  for (i = 0; i < params; ++i) {
2592  dec = va_arg (args, cob_decimal **);
2593  *dec = cob_decimal_base + i;
2594  }
2595  va_end (args);
2596 }
int cob_decimal_cmp ( cob_decimal *  d1,
cob_decimal *  d2 
)

References align_decimal(), and cob_decimal::value.

Referenced by cob_cmp_int(), cob_cmp_llint(), cob_cmp_uint(), cob_intr_acos(), cob_intr_asin(), and cob_numeric_cmp().

1923 {
1924  align_decimal (d1, d2);
1925  return mpz_cmp (d1->value, d2->value);
1926 }
void cob_decimal_div ( cob_decimal *  d1,
cob_decimal *  d2 
)

References COB_DECIMAL_NAN, COB_EC_SIZE_ZERO_DIVIDE, COB_MAX_DIGITS, cob_set_exception(), DECIMAL_CHECK, cob_decimal::scale, shift_decimal(), unlikely, and cob_decimal::value.

Referenced by cob_decimal_pow(), cob_div(), cob_div_quotient(), cob_intr_annuity(), cob_intr_binop(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_present_value(), cob_intr_standard_deviation(), cob_intr_variance(), and cob_mod_or_rem().

1900 {
1901  DECIMAL_CHECK (d1, d2);
1902 
1903  /* Check for division by zero */
1904  if (unlikely(mpz_sgn (d2->value) == 0)) {
1905  d1->scale = COB_DECIMAL_NAN;
1906  cob_set_exception (COB_EC_SIZE_ZERO_DIVIDE);
1907  return;
1908  }
1909  if (unlikely(mpz_sgn (d1->value) == 0)) {
1910  d1->scale = 0;
1911  return;
1912  }
1913  d1->scale -= d2->scale;
1914  shift_decimal (d1, COB_MAX_DIGITS + ((d1->scale < 0) ? -d1->scale : 0));
1915 #if 0 /* RXWRXW - cdiv */
1916  mpz_cdiv_q (d1->value, d1->value, d2->value);
1917 #endif
1918  mpz_tdiv_q (d1->value, d1->value, d2->value);
1919 }
static void cob_decimal_do_round ( cob_decimal *  d,
cob_field *  f,
const int  opt 
)
static

References COB_EC_SIZE_TRUNCATION, COB_FIELD_SCALE, cob_mpzt, cob_mpzt2, cob_set_exception(), COB_STORE_AWAY_FROM_ZERO, COB_STORE_MASK, COB_STORE_NEAR_AWAY_FROM_ZERO, COB_STORE_NEAR_EVEN, COB_STORE_NEAR_TOWARD_ZERO, COB_STORE_PROHIBITED, COB_STORE_TOWARD_GREATER, COB_STORE_TOWARD_LESSER, COB_STORE_TRUNCATION, cob_uli_t, cob_decimal::scale, shift_decimal(), sign, and cob_decimal::value.

Referenced by cob_decimal_get_field().

1694 {
1695  cob_uli_t adj;
1696  int sign;
1697  int scale;
1698 
1699  sign = mpz_sgn (d->value);
1700  /* Returns 0 when value is 0 */
1701  if (!sign) {
1702  return;
1703  }
1704  scale = COB_FIELD_SCALE(f);
1705  if (scale >= d->scale) {
1706  return;
1707  }
1708 
1709  switch (opt & ~(COB_STORE_MASK)) {
1710  case COB_STORE_TRUNCATION:
1711  return;
1712  case COB_STORE_PROHIBITED:
1713  cob_set_exception (COB_EC_SIZE_TRUNCATION);
1714  return;
1715  case COB_STORE_AWAY_FROM_ZERO:
1716  adj = d->scale - scale;
1717  mpz_ui_pow_ui (cob_mpzt, 10UL, adj);
1718  mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt);
1719  if (mpz_sgn (cob_mpzt2)) {
1720  /* Not exact number */
1721  if (sign < 0) {
1722  mpz_sub (d->value, d->value, cob_mpzt);
1723  } else {
1724  mpz_add (d->value, d->value, cob_mpzt);
1725  }
1726  }
1727  return;
1728  case COB_STORE_NEAR_TOWARD_ZERO:
1729  adj = d->scale - scale - 1;
1730  mpz_ui_pow_ui (cob_mpzt, 10UL, adj);
1731  mpz_mul_ui (cob_mpzt, cob_mpzt, 5UL);
1732  mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt);
1733  shift_decimal (d, scale - d->scale + 1);
1734  if (!mpz_sgn (cob_mpzt2)) {
1735  return;
1736  }
1737  if (sign > 0) {
1738  mpz_add_ui (d->value, d->value, 5UL);
1739  } else {
1740  mpz_sub_ui (d->value, d->value, 5UL);
1741  }
1742  return;
1743  case COB_STORE_TOWARD_GREATER:
1744  adj = d->scale - scale;
1745  mpz_ui_pow_ui (cob_mpzt, 10UL, adj);
1746  mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt);
1747  if (mpz_sgn (cob_mpzt2)) {
1748  /* Not exact number */
1749  if (sign > 0) {
1750  mpz_add (d->value, d->value, cob_mpzt);
1751  }
1752  }
1753  return;
1754  case COB_STORE_TOWARD_LESSER:
1755  adj = d->scale - scale;
1756  mpz_ui_pow_ui (cob_mpzt, 10UL, adj);
1757  mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt);
1758  if (mpz_sgn (cob_mpzt2)) {
1759  /* Not exact number */
1760  if (sign < 0) {
1761  mpz_sub (d->value, d->value, cob_mpzt);
1762  }
1763  }
1764  return;
1765  case COB_STORE_NEAR_EVEN:
1766  adj = d->scale - scale - 1;
1767  mpz_ui_pow_ui (cob_mpzt, 10UL, adj);
1768  mpz_mul_ui (cob_mpzt, cob_mpzt, 5UL);
1769  mpz_tdiv_r (cob_mpzt, d->value, cob_mpzt);
1770  shift_decimal (d, scale - d->scale + 1);
1771  if (!mpz_sgn (cob_mpzt)) {
1772  adj = mpz_tdiv_ui (d->value, 100UL);
1773  switch (adj) {
1774  case 5:
1775  case 25:
1776  case 45:
1777  case 65:
1778  case 85:
1779  return;
1780  }
1781  }
1782  if (sign > 0) {
1783  mpz_add_ui (d->value, d->value, 5UL);
1784  } else {
1785  mpz_sub_ui (d->value, d->value, 5UL);
1786  }
1787  return;
1788  case COB_STORE_NEAR_AWAY_FROM_ZERO:
1789  default:
1790  shift_decimal (d, scale - d->scale + 1);
1791  if (sign > 0) {
1792  mpz_add_ui (d->value, d->value, 5UL);
1793  } else {
1794  mpz_sub_ui (d->value, d->value, 5UL);
1795  }
1796  return;
1797  }
1798 }
static int cob_decimal_get_binary ( cob_decimal *  d,
cob_field *  f,
const int  opt 
)
static

References cob_binary_set_int64(), cob_binary_set_uint64(), __cob_global::cob_exception_code, COB_FIELD_BINARY_TRUNC, COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, cob_mpze10, cob_mpzt, cob_s64_t, cob_set_exception(), COB_STORE_TRUNC_ON_OVERFLOW, cob_u64_t, cob_field::data, overflow, sign, cob_field::size, unlikely, and cob_decimal::value.

Referenced by cob_decimal_get_field().

1508 {
1509  size_t overflow;
1510  size_t sign;
1511  size_t bitnum;
1512  size_t digits;
1513 
1514 #if !defined(COB_EXPERIMENTAL) && !defined(COB_LI_IS_LL)
1515  cob_s64_t llval;
1516  cob_u64_t ullval;
1517  unsigned int lo;
1518 #endif
1519 
1520  if (unlikely(mpz_size (d->value) == 0)) {
1521  memset (f->data, 0, f->size);
1522  return 0;
1523  }
1524  overflow = 0;
1525  digits = COB_FIELD_DIGITS(f);
1526  if (COB_FIELD_HAVE_SIGN (f)) {
1527  sign = 1;
1528  } else {
1529  sign = 0;
1530  if (mpz_sgn (d->value) < 0) {
1531  mpz_abs (d->value, d->value);
1532  }
1533  }
1534  bitnum = (f->size * 8) - sign;
1535  if (unlikely(mpz_sizeinbase (d->value, 2) > bitnum)) {
1536  if (opt & COB_STORE_KEEP_ON_OVERFLOW) {
1537  goto overflow;
1538  }
1539  overflow = 1;
1540  /* Check if truncation to PIC digits is needed */
1541  if (opt & COB_STORE_TRUNC_ON_OVERFLOW) {
1542  mpz_tdiv_r (d->value, d->value, cob_mpze10[digits]);
1543  } else {
1544 #if 0 /* RXWRXW - Fdiv sign */
1545  mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8) - sign);
1546 #endif
1547  mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8));
1548  }
1549  } else if (opt && COB_FIELD_BINARY_TRUNC (f)) {
1550  if (mpz_cmpabs (d->value, cob_mpze10[digits]) >= 0) {
1551  /* Overflow */
1552  if (opt & COB_STORE_KEEP_ON_OVERFLOW) {
1553  goto overflow;
1554  }
1555  overflow = 1;
1556  /* Check if truncation to PIC digits is needed */
1557  if (opt & COB_STORE_TRUNC_ON_OVERFLOW) {
1558  mpz_tdiv_r (d->value, d->value,
1559  cob_mpze10[digits]);
1560  } else {
1561  mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8));
1562  }
1563  }
1564  }
1565 #ifdef COB_LI_IS_LL
1566  if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) {
1567  cob_binary_set_uint64 (f, mpz_get_ui (d->value));
1568  } else {
1569  cob_binary_set_int64 (f, mpz_get_si (d->value));
1570  }
1571 #elif defined(COB_EXPERIMENTAL)
1572  if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) {
1573  cob_binary_set_uint64 (f, mpz_get_ull (d->value));
1574  } else {
1575  cob_binary_set_int64 (f, mpz_get_sll (d->value));
1576  }
1577 #else
1578  if (f->size <= 4) {
1579  if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) {
1580  cob_binary_set_uint64 (f, (cob_u64_t)mpz_get_ui (d->value));
1581  } else {
1582  cob_binary_set_int64 (f, (cob_s64_t)mpz_get_si (d->value));
1583  }
1584  } else {
1585  mpz_fdiv_r_2exp (cob_mpzt, d->value, 32);
1586  mpz_fdiv_q_2exp (d->value, d->value, 32);
1587  lo = mpz_get_ui (cob_mpzt);
1588 
1589  if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) {
1590  ullval = mpz_get_ui (d->value);
1591  ullval = (ullval << 32) | lo;
1592  cob_binary_set_uint64 (f, ullval);
1593  } else {
1594  llval = mpz_get_si (d->value);
1595  llval = (llval << 32) | lo;
1596  cob_binary_set_int64 (f, llval);
1597  }
1598  }
1599 #endif
1600  if (!overflow) {
1601  return 0;
1602  }
1603 
1604 overflow:
1605  cob_set_exception (COB_EC_SIZE_OVERFLOW);
1606  return cobglobptr->cob_exception_code;
1607 }
static int cob_decimal_get_display ( cob_decimal *  d,
cob_field *  f,
const int  opt 
)
static

References __cob_global::cob_exception_code, COB_FIELD_DATA, COB_FIELD_SIZE, cob_gmp_free(), COB_PUT_SIGN, cob_set_exception(), NULL, p, sign, unlikely, and cob_decimal::value.

Referenced by cob_decimal_get_field().

1372 {
1373  unsigned char *data;
1374  char *p;
1375  size_t size;
1376  int diff;
1377  int sign;
1378 
1379  data = COB_FIELD_DATA (f);
1380  /* Build string */
1381  sign = mpz_sgn (d->value);
1382  if (!sign) {
1383  /* Value is 0 */
1384  memset (data, '0', COB_FIELD_SIZE (f));
1385  COB_PUT_SIGN (f, sign);
1386  return 0;
1387  }
1388  if (sign < 0) {
1389  mpz_abs (d->value, d->value);
1390  }
1391  p = mpz_get_str (NULL, 10, d->value);
1392  size = strlen (p);
1393 
1394  /* Store number */
1395  diff = (int)(COB_FIELD_SIZE (f) - size);
1396  if (unlikely(diff < 0)) {
1397  /* Overflow */
1398  cob_set_exception (COB_EC_SIZE_OVERFLOW);
1399 
1400  /* If the statement has ON SIZE ERROR or NOT ON SIZE ERROR,
1401  then throw an exception */
1402  if (opt & COB_STORE_KEEP_ON_OVERFLOW) {
1403  cob_gmp_free(p);
1404  return cobglobptr->cob_exception_code;
1405  }
1406 
1407  /* Othersize, truncate digits */
1408  memcpy (data, p - diff, COB_FIELD_SIZE (f));
1409  } else {
1410  /* No overflow */
1411  memset (data, '0', (size_t)diff);
1412  memcpy (data + diff, p, size);
1413  }
1414 
1415  cob_gmp_free(p);
1416  COB_PUT_SIGN (f, sign);
1417 
1418  return 0;
1419 }
static double cob_decimal_get_double ( cob_decimal *  d)
static

References cob_mexp, cob_mpft, cob_mpft_get, cob_sli_t, cob_uli_t, cob_decimal::scale, unlikely, and cob_decimal::value.

Referenced by cob_cmp_float(), and cob_decimal_get_field().

878 {
879  double v;
880  cob_sli_t n;
881 
882  v = 0.0;
883  if (unlikely(mpz_size (d->value) == 0)) {
884  return v;
885  }
886 
887  mpf_set_z (cob_mpft, d->value);
888 
889  n = d->scale;
890  if (n < 0) {
891  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-n);
892  mpf_set_z (cob_mpft_get, cob_mexp);
893  mpf_mul (cob_mpft, cob_mpft, cob_mpft_get);
894  } else if (n > 0) {
895  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)n);
896  mpf_set_z (cob_mpft_get, cob_mexp);
897  mpf_div (cob_mpft, cob_mpft, cob_mpft_get);
898  }
899 
900  v = mpf_get_d (cob_mpft);
901  if (!finite (v)) {
902  v = 0.0;
903  }
904  return v;
905 }
int cob_decimal_get_field ( cob_decimal *  d,
cob_field *  f,
const int  opt 
)

References cob_field::attr, COB_ATTR_INIT, cob_d1, cob_decimal_do_round(), cob_decimal_get_binary(), cob_decimal_get_display(), cob_decimal_get_double(), cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), cob_decimal_get_packed(), COB_DECIMAL_NAN, __cob_global::cob_exception_code, COB_FIELD_DIGITS, COB_FIELD_IS_FP, COB_FIELD_SCALE, COB_FIELD_TYPE, COB_FLAG_HAVE_SIGN, cob_free(), cob_malloc(), cob_move(), cob_set_exception(), COB_STORE_ROUND, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_PACKED, cob_field::data, NULL, cob_decimal::scale, shift_decimal(), cob_field::size, unlikely, and cob_decimal::value.

Referenced by cob_add(), cob_add_int(), cob_decimal_move_temp(), cob_decimal_setget_fld(), cob_div(), cob_div_quotient(), cob_div_remainder(), cob_intr_abs(), cob_intr_acos(), cob_intr_annuity(), cob_intr_asin(), cob_intr_atan(), cob_intr_binop(), cob_intr_cos(), cob_intr_e(), cob_intr_exp(), cob_intr_exp10(), cob_intr_factorial(), cob_intr_fraction_part(), cob_intr_highest_algebraic(), cob_intr_integer(), cob_intr_integer_part(), cob_intr_log(), cob_intr_log10(), cob_intr_lowest_algebraic(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_numval(), cob_intr_numval_c(), cob_intr_numval_f(), cob_intr_pi(), cob_intr_present_value(), cob_intr_range(), cob_intr_sin(), cob_intr_sqrt(), cob_intr_standard_deviation(), cob_intr_sum(), cob_intr_tan(), cob_intr_variance(), cob_mod_or_rem(), cob_mul(), and cob_sub().

1802 {
1803  cob_field temp;
1804  cob_field_attr attr;
1805  union {
1806  double val;
1807  float fval;
1808  } uval;
1809 
1810  if (unlikely(d->scale == COB_DECIMAL_NAN)) {
1811  cob_set_exception (COB_EC_SIZE_OVERFLOW);
1812  return cobglobptr->cob_exception_code;
1813  }
1814 
1815  /* work copy */
1816  if (d != &cob_d1) {
1817  mpz_set (cob_d1.value, d->value);
1818  cob_d1.scale = d->scale;
1819  d = &cob_d1;
1820  }
1821 
1822 #if 0 /* RXWRXW - Round FP */
1823  if (!COB_FIELD_IS_FP(f)) {
1824 #endif
1825  /* Rounding */
1826  if ((opt & COB_STORE_ROUND)) {
1827  cob_decimal_do_round (d, f, opt);
1828  }
1829  /* Append or truncate decimal digits */
1830  shift_decimal (d, COB_FIELD_SCALE(f) - d->scale);
1831 #if 0 /* RXWRXW - Round FP */
1832  }
1833 #endif
1834 
1835  /* Store number */
1836  switch (COB_FIELD_TYPE (f)) {
1837  case COB_TYPE_NUMERIC_BINARY:
1838  return cob_decimal_get_binary (d, f, opt);
1839  case COB_TYPE_NUMERIC_DISPLAY:
1840  return cob_decimal_get_display (d, f, opt);
1841  case COB_TYPE_NUMERIC_PACKED:
1842  return cob_decimal_get_packed (d, f, opt);
1843  case COB_TYPE_NUMERIC_FLOAT:
1844  uval.fval = (float) cob_decimal_get_double (d);
1845  memcpy (f->data, &uval.fval, sizeof (float));
1846  return 0;
1847  case COB_TYPE_NUMERIC_DOUBLE:
1848  uval.val = cob_decimal_get_double (d);
1849  memcpy (f->data, &uval.val, sizeof (double));
1850  return 0;
1851  case COB_TYPE_NUMERIC_FP_DEC64:
1852  return cob_decimal_get_ieee64dec (d, f, opt);
1853  case COB_TYPE_NUMERIC_FP_DEC128:
1854  return cob_decimal_get_ieee128dec (d, f, opt);
1855  default:
1856  break;
1857  }
1858  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, COB_FIELD_DIGITS(f),
1859  COB_FIELD_SCALE(f), COB_FLAG_HAVE_SIGN, NULL);
1860  temp.size = COB_FIELD_DIGITS(f);
1861  temp.data = cob_malloc (COB_FIELD_DIGITS(f));
1862  temp.attr = &attr;
1863  if (cob_decimal_get_display (d, &temp, opt) == 0) {
1864  cob_move (&temp, f);
1865  cob_free (temp.data);
1866  return 0;
1867  }
1868  cob_free (temp.data);
1869  return cobglobptr->cob_exception_code;
1870 }
static int cob_decimal_get_ieee128dec ( cob_decimal *  d,
cob_field *  f,
const int  opt 
)
static

References COB_128_MSW, COB_128_OR_EXTEND, COB_128_SIGF_1, COB_128_SIGF_2, COB_DEC_EXTEND, COB_DEC_SIGN, __cob_global::cob_exception_code, COB_MPZ_ENDIAN, cob_mpz_ten34m1, cob_mpze10, cob_set_exception(), COB_STORE_KEEP_ON_OVERFLOW, cob_u64_t, cob_field::data, NULL, cob_decimal::scale, sign, and cob_decimal::value.

Referenced by cob_decimal_get_field().

613 {
614  cob_u64_t expo;
615  cob_u64_t data[2];
616  int sign;
617 
618  sign = mpz_sgn (d->value);
619  if (!sign) {
620  memset (f->data, 0, (size_t)16);
621  return 0;
622  }
623  if (sign < 0) {
624  mpz_neg (d->value, d->value);
625  }
626  for ( ; ; d->scale--) {
627  if (!mpz_divisible_ui_p (d->value, 10UL)) {
628  break;
629  }
630  mpz_tdiv_q_ui (d->value, d->value, 10UL);
631  }
632  if (mpz_cmpabs (d->value, cob_mpz_ten34m1) >= 0) {
633  if (opt & COB_STORE_KEEP_ON_OVERFLOW) {
634  cob_set_exception (COB_EC_SIZE_OVERFLOW);
635  return cobglobptr->cob_exception_code;
636  }
637 #if 0 /* RXWRXW - FP Trunc */
638  if (d->scale > 0 ) {
639  for ( ; d->scale; ) {
640 #endif
641  for ( ; ; ) {
642  mpz_tdiv_q_ui (d->value, d->value, 10UL);
643  d->scale--;
644  if (mpz_cmpabs (d->value, cob_mpz_ten34m1) < 0) {
645  break;
646  }
647  }
648 #if 0 /* RXWRXW - FP Trunc */
649  } else {
650  mpz_tdiv_r (d->value, d->value, cob_mpze10[34]);
651  }
652 #endif
653  }
654  if (d->scale < -6176 || d->scale > 6111) {
655  cob_set_exception (COB_EC_SIZE_OVERFLOW);
656  return cobglobptr->cob_exception_code;
657  }
658  expo = 6176 - d->scale;
659 #if 0 /* Clamp */
660  expo = cob_clamp_decimal (d, 6176U, 6111U, 113U);
661 #endif
662 
663  data[0] = 0;
664  data[1] = 0;
665  mpz_export (data, NULL, -1, (size_t)16, COB_MPZ_ENDIAN,
666  (size_t)0, d->value);
667  /* Move in exponent */
668 #if 0 /* IEEE canonical */
669  if (mpz_sizeinbase (d->value, 2) > 113U) {
670  COB_128_MSW(data) &= COB_128_SIGF_2;
671  COB_128_MSW(data) |= (expo << 47U) |
672  COB_DEC_EXTEND | COB_128_OR_EXTEND;
673  } else {
674 #endif
675  COB_128_MSW(data) &= COB_128_SIGF_1;
676  COB_128_MSW(data) |= (expo << 49U);
677 #if 0 /* IEEE canonical */
678  }
679 #endif
680  if (sign < 0) {
681  COB_128_MSW(data) |= COB_DEC_SIGN;
682  }
683  memcpy (f->data, data, (size_t)16);
684  return 0;
685 }
static int cob_decimal_get_ieee64dec ( cob_decimal *  d,
cob_field *  f,
const int  opt 
)
static

References COB_64_OR_EXTEND, COB_64_SIGF_1, COB_64_SIGF_2, COB_DEC_EXTEND, COB_DEC_SIGN, __cob_global::cob_exception_code, COB_MPZ_ENDIAN, cob_mpz_ten16m1, cob_mpze10, cob_set_exception(), COB_STORE_KEEP_ON_OVERFLOW, cob_u64_t, cob_field::data, NULL, cob_decimal::scale, sign, and cob_decimal::value.

Referenced by cob_decimal_get_field().

482 {
483  int sign;
484  cob_u64_t expo;
485  cob_u64_t data;
486 
487  sign = mpz_sgn (d->value);
488  if (!sign) {
489  memset (f->data, 0, (size_t)8);
490  return 0;
491  }
492  if (sign < 0) {
493  mpz_neg (d->value, d->value);
494  }
495  for ( ; ; d->scale--) {
496  if (!mpz_divisible_ui_p (d->value, 10UL)) {
497  break;
498  }
499  mpz_tdiv_q_ui (d->value, d->value, 10UL);
500  }
501  if (mpz_cmpabs (d->value, cob_mpz_ten16m1) >= 0) {
502  if (opt & COB_STORE_KEEP_ON_OVERFLOW) {
503  cob_set_exception (COB_EC_SIZE_OVERFLOW);
504  return cobglobptr->cob_exception_code;
505  }
506 #if 0 /* RXWRXW - FP Trunc */
507  if (d->scale > 0 ) {
508  for ( ; d->scale; ) {
509 #endif
510  for ( ; ; ) {
511  mpz_tdiv_q_ui (d->value, d->value, 10UL);
512  d->scale--;
513  if (mpz_cmpabs (d->value, cob_mpz_ten16m1) < 0) {
514  break;
515  }
516  }
517 #if 0 /* RXWRXW - FP Trunc */
518  } else {
519  mpz_tdiv_r (d->value, d->value, cob_mpze10[16]);
520  }
521 #endif
522  }
523  if (d->scale < -398 || d->scale > 369) {
524  cob_set_exception (COB_EC_SIZE_OVERFLOW);
525  return cobglobptr->cob_exception_code;
526  }
527  expo = 398 - d->scale;
528 #if 0 /* Clamp */
529  expo = cob_clamp_decimal (d, 398U, 369U, 53U);
530 #endif
531 
532  data = 0;
533  mpz_export (&data, NULL, -1, (size_t)8, COB_MPZ_ENDIAN,
534  (size_t)0, d->value);
535  /* Move in exponent */
536  if (mpz_sizeinbase (d->value, 2) > 51U) {
537  data &= COB_64_SIGF_2;
538  data |= (expo << 51U) | COB_DEC_EXTEND | COB_64_OR_EXTEND;
539  } else {
540  data &= COB_64_SIGF_1;
541  data |= (expo << 53U);
542  }
543  if (sign < 0) {
544  data |= COB_DEC_SIGN;
545  }
546  memcpy (f->data, &data, (size_t)8);
547  return 0;
548 }
static int cob_decimal_get_packed ( cob_decimal *  d,
cob_field *  f,
const int  opt 
)
static

References COB_D2I, __cob_global::cob_exception_code, COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, COB_FIELD_NO_SIGN_NIBBLE, cob_gmp_free(), cob_set_exception(), cob_set_packed_zero(), cob_field::data, NULL, p, sign, cob_field::size, unlikely, and cob_decimal::value.

Referenced by cob_decimal_get_field().

1148 {
1149  unsigned char *data;
1150  unsigned char *p;
1151  unsigned char *q;
1152  char *mza;
1153  size_t size;
1154  size_t n;
1155  size_t i;
1156  int diff;
1157  int sign;
1158  int digits;
1159  unsigned int x;
1160 
1161 #if 0 /* RXWRXW stack */
1162  char buff[1024];
1163 #endif
1164 
1165  /* Build string */
1166  sign = mpz_sgn (d->value);
1167  if (!sign) {
1168  /* Value is 0 */
1169  cob_set_packed_zero (f);
1170  return 0;
1171  }
1172  if (sign < 0) {
1173  mpz_abs (d->value, d->value);
1174  }
1175 
1176 #if 0 /* RXWRXW stack */
1177  if (unlikely(mpz_sizeinbase (d->value, 10) > sizeof(buff) - 1)) {
1178 #endif
1179  mza = mpz_get_str (NULL, 10, d->value);
1180 #if 0 /* RXWRXW stack */
1181  } else {
1182  mza = buff;
1183  (void)mpz_get_str (buff, 10, d->value);
1184  }
1185 #endif
1186  size = strlen (mza);
1187 
1188  /* Store number */
1189  data = f->data;
1190  digits = COB_FIELD_DIGITS (f);
1191 #if 0 /* RXWRXW - P Fix */
1192  if (digits > (f->size * 2) - 1) {
1193  digits = (f->size * 2) - 1;
1194  }
1195 #endif
1196  q = (unsigned char *)mza;
1197  diff = (int)(digits - size);
1198  if (diff < 0) {
1199  /* Overflow */
1200  cob_set_exception (COB_EC_SIZE_OVERFLOW);
1201 
1202  /* If the statement has SIZE ERROR
1203  then throw an exception */
1204  if (opt & COB_STORE_KEEP_ON_OVERFLOW) {
1205 #if 0 /* RXWRXW stack */
1206  if (unlikely(mza != buff)) {
1207 #endif
1208  cob_gmp_free(mza);
1209 
1210 #if 0 /* RXWRXW stack */
1211  }
1212 #endif
1213  return cobglobptr->cob_exception_code;
1214  }
1215  q += size - digits;
1216  size = digits;
1217  }
1218  memset (data, 0, f->size);
1219  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
1220  p = data + ((digits - 1) / 2) - ((size - 1) / 2);
1221  diff = (int)(size % 2);
1222  } else {
1223  p = data + (digits / 2) - (size / 2);
1224  diff = 1 - (int)(size % 2);
1225  }
1226  for (i = diff, n = 0; i < size + diff; i++, n++) {
1227  x = COB_D2I (q[n]);
1228  if (i % 2 == 0) {
1229  *p = x << 4;
1230  } else {
1231  *p++ |= x;
1232  }
1233  }
1234 
1235 #if 0 /* RXWRXW stack */
1236  if (unlikely(mza != buff)) {
1237 #endif
1238  cob_gmp_free(mza);
1239 
1240 #if 0 /* RXWRXW stack */
1241  }
1242 #endif
1243 
1244  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
1245  return 0;
1246  }
1247 
1248  p = f->data + f->size - 1;
1249  if (!COB_FIELD_HAVE_SIGN (f)) {
1250  *p = (*p & 0xF0U) | 0x0FU;
1251  } else if (sign < 0) {
1252  *p = (*p & 0xF0U) | 0x0DU;
1253  } else {
1254  *p = (*p & 0xF0U) | 0x0CU;
1255  }
1256 
1257  return 0;
1258 }
void cob_decimal_init ( cob_decimal *  d)

References COB_MPZ_DEF, cob_decimal::scale, and cob_decimal::value.

Referenced by cob_decimal_push(), and cob_init_numeric().

322 {
323  mpz_init2 (d->value, COB_MPZ_DEF);
324  d->scale = 0;
325 }
void cob_decimal_mul ( cob_decimal *  d1,
cob_decimal *  d2 
)

References DECIMAL_CHECK, cob_decimal::scale, and cob_decimal::value.

Referenced by cob_div_quotient(), cob_intr_binop(), cob_intr_standard_deviation(), cob_intr_variance(), cob_mod_or_rem(), and cob_mul().

1892 {
1893  DECIMAL_CHECK (d1, d2);
1894  d1->scale += d2->scale;
1895  mpz_mul (d1->value, d1->value, d2->value);
1896 }
void cob_decimal_pop ( const cob_u32_t  params,
  ... 
)

References cob_free(), cob_u32_t, params, and cob_decimal::value.

2616 {
2617  cob_decimal *dec;
2618  cob_u32_t i;
2619  va_list args;
2620 
2621  va_start (args, params);
2622  for (i = 0; i < params; ++i) {
2623  dec = va_arg (args, cob_decimal *);
2624  mpz_clear (dec->value);
2625  cob_free (dec);
2626  }
2627  va_end (args);
2628 }
static void cob_decimal_print ( cob_decimal *  d,
FILE *  fp 
)
static

References COB_DECIMAL_INF, COB_DECIMAL_NAN, cob_mpzt2, cob_decimal::scale, unlikely, and cob_decimal::value.

Referenced by cob_print_ieeedec().

365 {
366  int scale;
367 
368  if (unlikely(d->scale == COB_DECIMAL_NAN)) {
369  fprintf (fp, "(Nan)");
370  return;
371  }
372  if (unlikely(d->scale == COB_DECIMAL_INF)) {
373  fprintf (fp, "(Inf)");
374  return;
375  }
376  if (!mpz_sgn (d->value)) {
377  fprintf (fp, "0E0");
378  return;
379  }
380  mpz_set (cob_mpzt2, d->value);
381  scale = d->scale;
382  for ( ; ; ) {
383  if (!mpz_divisible_ui_p (cob_mpzt2, 10UL)) {
384  break;
385  }
386  mpz_tdiv_q_ui (cob_mpzt2, cob_mpzt2, 10UL);
387  scale--;
388  }
389  gmp_fprintf (fp, "%ZdE%d", cob_mpzt2, -scale);
390 }
void cob_decimal_push ( const cob_u32_t  params,
  ... 
)

References cob_decimal_init(), cob_malloc(), cob_u32_t, and params.

2600 {
2601  cob_decimal **dec;
2602  cob_u32_t i;
2603  va_list args;
2604 
2605  va_start (args, params);
2606  for (i = 0; i < params; ++i) {
2607  dec = va_arg (args, cob_decimal **);
2608  *dec = cob_malloc (sizeof(cob_decimal));
2609  cob_decimal_init (*dec);
2610  }
2611  va_end (args);
2612 }
static COB_INLINE COB_A_INLINE void cob_decimal_set ( cob_decimal *  dst,
const cob_decimal *  src 
)
static

References cob_decimal::scale, and cob_decimal::value.

Referenced by cob_div_quotient().

357 {
358  mpz_set (dst->value, src->value);
359  dst->scale = src->scale;
360 }
static void cob_decimal_set_binary ( cob_decimal *  d,
cob_field *  f 
)
static

References cob_binary_get_sint64(), cob_binary_get_uint64(), COB_FIELD_BINARY_SWAP, COB_FIELD_HAVE_SIGN, COB_FIELD_SCALE, COB_MAX_BINARY, cob_s64_t, cob_sli_t, cob_u64_t, cob_uli_t, cob_field::data, cob_decimal::scale, cob_field::size, and cob_decimal::value.

Referenced by cob_decimal_set_field().

1425 {
1426 #ifdef COB_EXPERIMENTAL
1427 #if 1 /* RXWRXW - set_usll */
1428  size_t size;
1429  size_t sizeb;
1430  size_t idx;
1431  int order;
1432  unsigned char buff[COB_MAX_BINARY + 1];
1433 
1434  size = f->size;
1435 #ifndef WORDS_BIGENDIAN
1436  if (!COB_FIELD_BINARY_SWAP (f)) {
1437  sizeb = size - 1;
1438  order = -1;
1439  } else {
1440  sizeb = 0;
1441  order = 1;
1442  }
1443 #else
1444  sizeb = 0;
1445  order = 1;
1446 #endif
1447  if (COB_FIELD_HAVE_SIGN (f) && (f->data[sizeb] & 0x80U)) {
1448  for (idx = 0; idx < size; ++idx) {
1449  buff[idx] = ~f->data[idx];
1450  }
1451  mpz_import (d->value, 1, order, size, order, 0, buff);
1452  mpz_com (d->value, d->value);
1453  } else {
1454  mpz_import (d->value, 1, order, size, order, 0, f->data);
1455  }
1456 
1457 #else
1458  if (COB_FIELD_HAVE_SIGN (f)) {
1459  mpz_set_sll (d->value, cob_binary_get_sint64 (f));
1460  } else {
1461  mpz_set_ull (d->value, cob_binary_get_uint64 (f));
1462  }
1463 #endif
1464 
1465 #elif defined(COB_LI_IS_LL)
1466  if (COB_FIELD_HAVE_SIGN (f)) {
1467  mpz_set_si (d->value, cob_binary_get_sint64 (f));
1468  } else {
1469  mpz_set_ui (d->value, cob_binary_get_uint64 (f));
1470  }
1471 #else
1472  cob_u64_t uval;
1473  cob_s64_t val;
1474  size_t negative;
1475 
1476  if (f->size <= 4) {
1477  if (COB_FIELD_HAVE_SIGN (f)) {
1478  mpz_set_si (d->value, (cob_sli_t)cob_binary_get_sint64 (f));
1479  } else {
1480  mpz_set_ui (d->value, (cob_uli_t) cob_binary_get_uint64 (f));
1481  }
1482  } else {
1483  negative = 0;
1484  if (COB_FIELD_HAVE_SIGN (f)) {
1485  val = cob_binary_get_sint64 (f);
1486  if (val < 0) {
1487  negative = 1;
1488  uval = (cob_u64_t)-val;
1489  } else {
1490  uval = (cob_u64_t)val;
1491  }
1492  } else {
1493  uval = cob_binary_get_uint64 (f);
1494  }
1495  mpz_set_ui (d->value, (cob_uli_t)(uval >> 32));
1496  mpz_mul_2exp (d->value, d->value, 32);
1497  mpz_add_ui (d->value, d->value, (cob_uli_t)(uval & 0xFFFFFFFFU));
1498  if (negative) {
1499  mpz_neg (d->value, d->value);
1500  }
1501  }
1502 #endif
1503  d->scale = COB_FIELD_SCALE(f);
1504 }
static void cob_decimal_set_display ( cob_decimal *  d,
cob_field *  f 
)
static

References COB_D2I, cob_fast_malloc(), COB_FIELD_DATA, COB_FIELD_SCALE, COB_FIELD_SIZE, cob_free(), COB_GET_SIGN, COB_PUT_SIGN, cob_uli_t, p, cob_decimal::scale, sign, unlikely, and cob_decimal::value.

Referenced by cob_decimal_set_field().

1309 {
1310  unsigned char *data;
1311  unsigned char *p;
1312  size_t size;
1313  int sign;
1314  cob_uli_t n;
1315 
1316  data = COB_FIELD_DATA (f);
1317  size = COB_FIELD_SIZE (f);
1318  if (unlikely(*data == 255)) {
1319  mpz_ui_pow_ui (d->value, 10UL, (cob_uli_t)size);
1320  d->scale = COB_FIELD_SCALE(f);
1321  return;
1322  }
1323  if (unlikely(*data == 0)) {
1324  mpz_ui_pow_ui (d->value, 10UL, (cob_uli_t)size);
1325  mpz_neg (d->value, d->value);
1326  d->scale = COB_FIELD_SCALE(f);
1327  return;
1328  }
1329  sign = COB_GET_SIGN (f);
1330  /* Skip leading zeros (also invalid space/low-value) */
1331  while (size > 1 && (*data & 0x0FU) == 0) {
1332  size--;
1333  data++;
1334  }
1335 
1336  /* Set value */
1337  n = 0;
1338 
1339 #ifdef COB_LI_IS_LL
1340  if (size < 20) {
1341 #else
1342  if (size < 10) {
1343 #endif
1344  while (size--) {
1345  if (n) {
1346  n *= 10;
1347  }
1348  n += COB_D2I (*data);
1349  data++;
1350  }
1351  mpz_set_ui (d->value, n);
1352  } else {
1353  p = cob_fast_malloc (size + 1U);
1354  for (; n < size; ++n) {
1355  p[n] = (data[n] & 0x0FU) + '0';
1356  }
1357  p[size] = 0;
1358  mpz_set_str (d->value, (char *)p, 10);
1359  cob_free (p);
1360  }
1361 
1362  /* Set sign and scale */
1363  if (sign < 0 && mpz_sgn (d->value)) {
1364  mpz_neg (d->value, d->value);
1365  }
1366  d->scale = COB_FIELD_SCALE(f);
1367  COB_PUT_SIGN (f, sign);
1368 }
static void cob_decimal_set_double ( cob_decimal *  d,
const double  v 
)
static

References cob_gmp_free(), cob_mexp, cob_mpft, cob_sli_t, cob_u64_t, cob_uli_t, d1, NULL, p, cob_decimal::scale, sign, and cob_decimal::value.

Referenced by cob_decimal_set_field(), and cob_print_ieeedec().

822 {
823  char *p;
824  char *q;
825  cob_u64_t t1;
826  cob_sli_t scale;
827  cob_sli_t len;
828  int sign;
829  union {
830  double d1;
831  cob_u64_t l1;
832  } ud;
833 
834  memset (&t1, ' ', sizeof(t1));
835  ud.d1 = v;
836  if (ud.l1 == 0 || ud.l1 == t1 || !finite (v)) {
837  mpz_set_ui (d->value, 0UL);
838  d->scale = 0;
839  return;
840  }
841 
842  sign = 0;
843  mpf_set_d (cob_mpft, v);
844 
845  q = mpf_get_str (NULL, &scale, 10, (size_t)96, cob_mpft);
846  if (!*q) {
847  mpz_set_ui (d->value, 0UL);
848  d->scale = 0;
849  cob_gmp_free(q);
850  return;
851  }
852  p = q;
853  if (*p == '-') {
854  sign = 1;
855  ++p;
856  }
857 
858  mpz_set_str (d->value, p, 10);
859 
860  len = (cob_sli_t)strlen (p);
861  len -= scale;
862  if (len >= 0) {
863  d->scale = len;
864  } else {
865  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-len);
866  mpz_mul (d->value, d->value, cob_mexp);
867  d->scale = 0;
868  }
869 
870  if (sign) {
871  mpz_neg (d->value, d->value);
872  }
873  cob_gmp_free(q);
874 }
void cob_decimal_set_field ( cob_decimal *  d,
cob_field *  f 
)

References cob_decimal_set_binary(), cob_decimal_set_display(), cob_decimal_set_double(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), cob_decimal_set_packed(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_PACKED, and cob_field::data.

Referenced by cob_add(), cob_add_int(), cob_cmp_float(), cob_cmp_int(), cob_cmp_llint(), cob_cmp_uint(), cob_decimal_move_temp(), cob_decimal_setget_fld(), cob_div(), cob_div_quotient(), cob_intr_abs(), cob_intr_acos(), cob_intr_annuity(), cob_intr_asin(), cob_intr_atan(), cob_intr_binop(), cob_intr_cos(), cob_intr_exp(), cob_intr_exp10(), cob_intr_fraction_part(), cob_intr_integer(), cob_intr_integer_part(), cob_intr_log(), cob_intr_log10(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_present_value(), cob_intr_range(), cob_intr_sign(), cob_intr_sin(), cob_intr_sqrt(), cob_intr_standard_deviation(), cob_intr_sum(), cob_intr_tan(), cob_intr_variance(), cob_mod_or_rem(), cob_mul(), cob_numeric_cmp(), and cob_sub().

1613 {
1614  union {
1615  double dval;
1616  float fval;
1617  } uval;
1618 
1619  switch (COB_FIELD_TYPE (f)) {
1620  case COB_TYPE_NUMERIC_BINARY:
1621  cob_decimal_set_binary (d, f);
1622  break;
1623  case COB_TYPE_NUMERIC_PACKED:
1624  cob_decimal_set_packed (d, f);
1625  break;
1626  case COB_TYPE_NUMERIC_FLOAT:
1627  memcpy ((void *)&uval.fval, f->data, sizeof(float));
1628  cob_decimal_set_double (d, (double)uval.fval);
1629  break;
1630  case COB_TYPE_NUMERIC_DOUBLE:
1631  memcpy ((void *)&uval.dval, f->data, sizeof(double));
1632  cob_decimal_set_double (d, uval.dval);
1633  break;
1634  case COB_TYPE_NUMERIC_FP_DEC64:
1635  cob_decimal_set_ieee64dec (d, f);
1636  break;
1637  case COB_TYPE_NUMERIC_FP_DEC128:
1638  cob_decimal_set_ieee128dec (d, f);
1639  break;
1640  default:
1641  cob_decimal_set_display (d, f);
1642  break;
1643  }
1644 }
static void cob_decimal_set_ieee128dec ( cob_decimal *  d,
const cob_field *  f 
)
static

References COB_128_EXPO_1, COB_128_EXPO_2, COB_128_IS_EXTEND, COB_128_IS_SPECIAL, COB_128_LSW, COB_128_MSW, COB_128_OR_EXTEND, COB_128_SIGF_1, COB_128_SIGF_2, COB_DEC_SIGN, COB_DECIMAL_NAN, cob_mexp, cob_mpz_ten34m1, cob_u64_t, cob_uli_t, cob_field::data, cob_decimal::scale, sign, and cob_decimal::value.

Referenced by cob_decimal_set_field(), and cob_print_ieeedec().

689 {
690  cob_u64_t expo;
691  cob_u64_t sign;
692  cob_u64_t data[2];
693 
694  /* bit 0 : sign bit */
695  /* bits 1 - 4 : combination field */
696  /* combination = 15 (all bits set) is inf/nan */
697  /* combination > 11 (bits 1100) is extended exponent */
698  /* Exponent length - 14 bits */
699 
700  memcpy (data, f->data, sizeof(data));
701  sign = COB_128_MSW(data) & COB_DEC_SIGN;
702  if (COB_128_IS_SPECIAL (data)) {
703  /* Inf / Nan */
704  mpz_set_ui (d->value, 1UL);
705  d->scale = COB_DECIMAL_NAN;
706  return;
707  }
708  if (COB_128_IS_EXTEND (data)) {
709  expo = (COB_128_MSW(data) & COB_128_EXPO_2) >> 47U;
710  COB_128_MSW(data) &= COB_128_SIGF_2;
711  COB_128_MSW(data) |= COB_128_OR_EXTEND;
712 #if 0 /* RXWRXW - IEEE cap at 34 digits */
713  /* Non-canonical */
714  mpz_set_ui (d->value, 0);
715  d->scale = 0;
716  return;
717 #endif
718  } else {
719  expo = (COB_128_MSW(data) & COB_128_EXPO_1) >> 49U;
720  COB_128_MSW(data) &= COB_128_SIGF_1;
721  }
722  if (!COB_128_MSW(data) && !COB_128_LSW(data)) {
723  /* Significand 0 */
724  mpz_set_ui (d->value, 0UL);
725  d->scale = 0;
726  return;
727  }
728 #ifdef COB_LI_IS_LL
729  mpz_set_ui (d->value, COB_128_MSW(data));
730  mpz_mul_2exp (d->value, d->value, 64UL);
731  mpz_add_ui (d->value, d->value, COB_128_LSW(data));
732 #else
733  /* RXWRXW - Fixme */
734  mpz_set_ui (d->value, (cob_uli_t)(COB_128_MSW(data) >> 32U));
735  mpz_mul_2exp (d->value, d->value, 32UL);
736  mpz_add_ui (d->value, d->value, (cob_uli_t)(COB_128_MSW(data) & 0xFFFFFFFFU));
737  mpz_mul_2exp (d->value, d->value, 32UL);
738  mpz_add_ui (d->value, d->value, (cob_uli_t)(COB_128_LSW(data) >> 32U));
739  mpz_mul_2exp (d->value, d->value, 32UL);
740  mpz_add_ui (d->value, d->value, (cob_uli_t)(COB_128_LSW(data) & 0xFFFFFFFFU));
741 #endif
742 
743  if (mpz_cmpabs (d->value, cob_mpz_ten34m1) >= 0) {
744  /* Non-canonical */
745  mpz_set_ui (d->value, 0UL);
746  d->scale = 0;
747  return;
748  }
749  d->scale = (int)expo - 6176;
750  if (d->scale > 0) {
751  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d->scale);
752  mpz_mul (d->value, d->value, cob_mexp);
753  d->scale = 0;
754  } else if (d->scale < 0) {
755  d->scale = -(d->scale);
756  }
757  if (sign) {
758  mpz_neg (d->value, d->value);
759  }
760 }
static void cob_decimal_set_ieee64dec ( cob_decimal *  d,
const cob_field *  f 
)
static

References COB_64_EXPO_1, COB_64_EXPO_2, COB_64_IS_EXTEND, COB_64_IS_SPECIAL, COB_64_OR_EXTEND, COB_64_SIGF_1, COB_64_SIGF_2, COB_DEC_SIGN, COB_DECIMAL_NAN, cob_mexp, COB_U64_C, cob_u64_t, cob_uli_t, cob_field::data, cob_decimal::scale, sign, and cob_decimal::value.

Referenced by cob_decimal_set_field(), and cob_print_ieeedec().

552 {
553  cob_u64_t expo;
554  cob_u64_t sign;
555  cob_u64_t data;
556 
557  /* bit 0 : sign bit */
558  /* bits 1 - 4 : combination field */
559  /* combination = 15 (all bits set) is inf/nan */
560  /* combination > 11 (bits 1100) is extended exponent */
561  /* Exponent length - 10 bits */
562 
563  memcpy (&data, f->data, sizeof(data));
564  sign = data & COB_DEC_SIGN;
565  if (COB_64_IS_SPECIAL (data)) {
566  /* Inf / Nan */
567  mpz_set_ui (d->value, 1UL);
568  d->scale = COB_DECIMAL_NAN;
569  return;
570  }
571  if (COB_64_IS_EXTEND (data)) {
572  expo = (data & COB_64_EXPO_2) >> 51U;
573  data &= COB_64_SIGF_2;
574  data |= COB_64_OR_EXTEND;
575  if (data > COB_U64_C(9999999999999999)) {
576  mpz_set_ui (d->value, 0UL);
577  d->scale = 0;
578  return;
579  }
580  } else {
581  expo = (data & COB_64_EXPO_1) >> 53U;
582  data &= COB_64_SIGF_1;
583  }
584  if (!data) {
585  /* Significand 0 */
586  mpz_set_ui (d->value, 0UL);
587  d->scale = 0;
588  return;
589  }
590 #ifdef COB_LI_IS_LL
591  mpz_set_ui (d->value, data);
592 #else
593  mpz_set_ui (d->value, (cob_uli_t)(data >> 32));
594  mpz_mul_2exp (d->value, d->value, 32);
595  mpz_add_ui (d->value, d->value, (cob_uli_t)(data & 0xFFFFFFFFU));
596 #endif
597 
598  d->scale = (int)expo - 398;
599  if (d->scale > 0) {
600  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d->scale);
601  mpz_mul (d->value, d->value, cob_mexp);
602  d->scale = 0;
603  } else if (d->scale < 0) {
604  d->scale = -(d->scale);
605  }
606  if (sign) {
607  mpz_neg (d->value, d->value);
608  }
609 }
void cob_decimal_set_llint ( cob_decimal *  d,
const cob_s64_t  n 
)

References cob_sli_t, cob_u32_t, cob_u64_t, cob_uli_t, cob_decimal::scale, and cob_decimal::value.

329 {
330 #ifdef COB_LI_IS_LL
331  mpz_set_si (d->value, (cob_sli_t)n);
332 #else
333  cob_u64_t uval;
334  cob_u32_t negative;
335 
336  negative = 0;
337  if (n < 0) {
338  negative = 1;
339  uval = (cob_u64_t)-n;
340  } else {
341  uval = (cob_u64_t)n;
342  }
343  mpz_set_ui (d->value, (cob_uli_t)(uval >> 32));
344  mpz_mul_2exp (d->value, d->value, 32);
345  mpz_add_ui (d->value, d->value, (cob_uli_t)(uval & 0xFFFFFFFFU));
346  if (negative) {
347  mpz_neg (d->value, d->value);
348  }
349 #endif
350  d->scale = 0;
351 }
static void cob_decimal_set_packed ( cob_decimal *  d,
cob_field *  f 
)
static

References COB_FIELD_DIGITS, COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_SCALE, cob_packed_get_sign(), cob_uli_t, cob_field::data, p, cob_decimal::scale, sign, cob_field::size, unlikely, and cob_decimal::value.

Referenced by cob_decimal_set_field().

1088 {
1089  unsigned char *p;
1090  unsigned char *endp;
1091  int digits;
1092  int sign;
1093  int nibtest;
1094  unsigned int byteval;
1095  unsigned int nonzero;
1096 
1097  p = f->data;
1098  digits = COB_FIELD_DIGITS (f);
1099 #if 0 /* RXWRXW - P Fix */
1100  if (digits > (f->size * 2) - 1) {
1101  digits = (f->size * 2) - 1;
1102  }
1103 #endif
1104  sign = cob_packed_get_sign (f);
1105 
1106  if (unlikely(COB_FIELD_NO_SIGN_NIBBLE (f))) {
1107  endp = f->data + f->size;
1108  nibtest = 1;
1109  } else {
1110  endp = f->data + f->size - 1;
1111  nibtest = 0;
1112  }
1113 
1114  byteval = 0;
1115  if (digits % 2 == nibtest) {
1116  byteval = *p & 0x0FU;
1117  p++;
1118  }
1119  mpz_set_ui (d->value, (cob_uli_t)byteval);
1120  nonzero = !!byteval;
1121 
1122  for (; p < endp; p++) {
1123  if (nonzero) {
1124  mpz_mul_ui (d->value, d->value, 100UL);
1125  }
1126  if (*p) {
1127  mpz_add_ui (d->value, d->value,
1128  (cob_uli_t)((*p >> 4U) * 10U) + (*p & 0x0FU));
1129  nonzero = 1;
1130  }
1131  }
1132 
1133  if (!nibtest) {
1134  if (nonzero) {
1135  mpz_mul_ui (d->value, d->value, 10UL);
1136  }
1137  mpz_add_ui (d->value, d->value, (cob_uli_t)(*p >> 4U));
1138  }
1139 
1140  if (sign < 0) {
1141  mpz_neg (d->value, d->value);
1142  }
1143  d->scale = COB_FIELD_SCALE(f);
1144 }
void cob_decimal_setget_fld ( cob_field *  src,
cob_field *  dst,
const int  opt 
)

References cob_decimal_get_field(), and cob_decimal_set_field().

Referenced by cob_move().

2008 {
2009  cob_decimal_set_field (&cob_d1, src);
2010  (void)cob_decimal_get_field (&cob_d1, dst, opt);
2011 }
void cob_decimal_sub ( cob_decimal *  d1,
cob_decimal *  d2 
)

References align_decimal(), DECIMAL_CHECK, and cob_decimal::value.

Referenced by cob_div_quotient(), cob_intr_annuity(), cob_intr_binop(), cob_intr_range(), cob_intr_standard_deviation(), cob_intr_variance(), cob_mod_or_rem(), and cob_sub().

1884 {
1885  DECIMAL_CHECK (d1, d2);
1886  align_decimal (d1, d2);
1887  mpz_sub (d1->value, d1->value, d2->value);
1888 }
void cob_div ( cob_field *  f1,
cob_field *  f2,
const int  opt 
)

References cob_decimal_div(), cob_decimal_get_field(), and cob_decimal_set_field().

1959 {
1960  cob_decimal_set_field (&cob_d1, f1);
1961  cob_decimal_set_field (&cob_d2, f2);
1962  cob_decimal_div (&cob_d1, &cob_d2);
1963  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1964 }
void cob_div_quotient ( cob_field *  dividend,
cob_field *  divisor,
cob_field *  quotient,
const int  opt 
)

References cob_decimal_div(), cob_decimal_get_field(), cob_decimal_mul(), COB_DECIMAL_NAN, cob_decimal_set(), cob_decimal_set_field(), cob_decimal_sub(), COB_FIELD_SCALE, cob_decimal::scale, and shift_decimal().

1969 {
1970  /* Note that cob_div_quotient and cob_div_remainder must remain */
1971  /* separate because of COBOL rules. The quotient must be fully */
1972  /* evaluated before the remainder item is evaluated */
1973  /* eg. DIVIDE A BY B GIVING Z REMAINDER FLD (Z). */
1974 
1975  cob_decimal_set_field (&cob_d1, dividend);
1976  cob_decimal_set_field (&cob_d2, divisor);
1977  cob_decimal_set (&cob_d_remainder, &cob_d1);
1978 
1979  /* Compute quotient */
1980  cob_decimal_div (&cob_d1, &cob_d2);
1981  /* Check divide by zero - Exception is set in cob_decimal_div */
1982  if (cob_d1.scale == COB_DECIMAL_NAN) {
1983  /* Forces an early return from cob_div_remainder */
1984  cob_d_remainder.scale = COB_DECIMAL_NAN;
1985  return;
1986  }
1987 
1988  /* Set quotient */
1989  cob_decimal_set (&cob_d3, &cob_d1);
1990  (void)cob_decimal_get_field (&cob_d1, quotient, opt);
1991 
1992  /* Truncate digits from the quotient */
1993  shift_decimal (&cob_d3, COB_FIELD_SCALE(quotient) - cob_d3.scale);
1994 
1995  /* Compute remainder */
1996  cob_decimal_mul (&cob_d3, &cob_d2);
1997  cob_decimal_sub (&cob_d_remainder, &cob_d3);
1998 }
void cob_div_remainder ( cob_field *  fld_remainder,
const int  opt 
)

References cob_decimal_get_field().

2002 {
2003  (void)cob_decimal_get_field (&cob_d_remainder, fld_remainder, opt);
2004 }
void cob_exit_numeric ( void  )

References cob_decimal_base, cob_free(), COB_MAX_BINARY, COB_MAX_DEC_STRUCT, cob_mexp, cob_mpft, cob_mpft_get, cob_mpz_ten16m1, cob_mpz_ten34m1, cob_mpze10, cob_mpzt, cob_mpzt2, d1, and cob_decimal::value.

Referenced by cob_terminate_routines().

2634 {
2635  cob_decimal *d1;
2636  size_t i;
2637 
2638  d1 = cob_decimal_base;
2639  for (i = 0; i < COB_MAX_DEC_STRUCT; d1++, i++) {
2640  mpz_clear (d1->value);
2641  }
2642  cob_free (cob_decimal_base);
2643 
2644  mpz_clear (cob_d_remainder.value);
2645 
2646  mpz_clear (cob_d3.value);
2647  mpz_clear (cob_d2.value);
2648  mpz_clear (cob_d1.value);
2649 
2650  mpz_clear (cob_mexp);
2651  mpz_clear (cob_mpzt2);
2652  mpz_clear (cob_mpzt);
2653 
2654  mpz_clear (cob_mpz_ten34m1);
2655  mpz_clear (cob_mpz_ten16m1);
2656  for (i = 0; i < COB_MAX_BINARY; i++) {
2657  mpz_clear (cob_mpze10[i]);
2658  }
2659 
2660  mpf_clear (cob_mpft_get);
2661  mpf_clear (cob_mpft);
2662 }
static unsigned int cob_get_long_ebcdic_sign ( const unsigned char *  p,
cob_s64_t *  val 
)
static

Referenced by cob_cmp_numdisp().

2474 {
2475  switch (*p) {
2476  case '{':
2477  return 0;
2478  case 'A':
2479  *val += 1;
2480  return 0;
2481  case 'B':
2482  *val += 2;
2483  return 0;
2484  case 'C':
2485  *val += 3;
2486  return 0;
2487  case 'D':
2488  *val += 4;
2489  return 0;
2490  case 'E':
2491  *val += 5;
2492  return 0;
2493  case 'F':
2494  *val += 6;
2495  return 0;
2496  case 'G':
2497  *val += 7;
2498  return 0;
2499  case 'H':
2500  *val += 8;
2501  return 0;
2502  case 'I':
2503  *val += 9;
2504  return 0;
2505  case '}':
2506  return 1;
2507  case 'J':
2508  *val += 1;
2509  return 1;
2510  case 'K':
2511  *val += 2;
2512  return 1;
2513  case 'L':
2514  *val += 3;
2515  return 1;
2516  case 'M':
2517  *val += 4;
2518  return 1;
2519  case 'N':
2520  *val += 5;
2521  return 1;
2522  case 'O':
2523  *val += 6;
2524  return 1;
2525  case 'P':
2526  *val += 7;
2527  return 1;
2528  case 'Q':
2529  *val += 8;
2530  return 1;
2531  case 'R':
2532  *val += 9;
2533  return 1;
2534  }
2535  return 0;
2536 }
void cob_gmp_free ( void *  ptr)

References NULL.

Referenced by cob_decimal_get_display(), cob_decimal_get_packed(), cob_decimal_set_double(), and cob_decimal_set_mpf().

217  {
218 /* mpir/gmp free functions */
219 #ifdef HAVE_MP_GET_MEMORY_FUNCTIONS
220  void (*freefunc)(void *, size_t);
221  mp_get_memory_functions (NULL, NULL, &freefunc);
222  freefunc (ptr, strlen((char*) ptr) + 1);
223 #else
224  free (ptr);
225 #endif
226 }
void cob_init_numeric ( cob_global *  lptr)

References cob_decimal_base, cob_decimal_init(), cob_malloc(), COB_MAX_BINARY, COB_MAX_DEC_STRUCT, cob_mexp, COB_MPF_PREC, cob_mpft, cob_mpft_get, COB_MPZ_DEF, cob_mpz_ten16m1, cob_mpz_ten34m1, cob_mpze10, cob_mpzt, cob_mpzt2, cob_u32_t, cob_uli_t, d1, last_packed_val, and packed_value.

Referenced by cob_init().

2666 {
2667  cob_decimal *d1;
2668  cob_u32_t i;
2669 
2670  cobglobptr = lptr;
2671 
2672  memset (packed_value, 0, sizeof(packed_value));
2673  last_packed_val = 0;
2674 
2675  mpf_init2 (cob_mpft, COB_MPF_PREC);
2676  mpf_init2 (cob_mpft_get, COB_MPF_PREC);
2677 
2678  for (i = 0; i < COB_MAX_BINARY; i++) {
2679  mpz_init2 (cob_mpze10[i], 128UL);
2680  mpz_ui_pow_ui (cob_mpze10[i], 10UL, (cob_uli_t)i);
2681  }
2682  mpz_init_set (cob_mpz_ten16m1, cob_mpze10[16]);
2683  mpz_sub_ui (cob_mpz_ten16m1, cob_mpz_ten16m1, 1UL);
2684  mpz_init_set (cob_mpz_ten34m1, cob_mpze10[34]);
2685  mpz_sub_ui (cob_mpz_ten34m1, cob_mpz_ten34m1, 1UL);
2686 
2687  mpz_init2 (cob_mpzt, COB_MPZ_DEF);
2688  mpz_init2 (cob_mpzt2, COB_MPZ_DEF);
2689  mpz_init2 (cob_mexp, COB_MPZ_DEF);
2690 
2691  cob_decimal_init (&cob_d1);
2692  cob_decimal_init (&cob_d2);
2693  cob_decimal_init (&cob_d3);
2694  cob_decimal_init (&cob_d_remainder);
2695 
2696  cob_decimal_base = cob_malloc (COB_MAX_DEC_STRUCT * sizeof(cob_decimal));
2697  d1 = cob_decimal_base;
2698  for (i = 0; i < COB_MAX_DEC_STRUCT; d1++, i++) {
2699  cob_decimal_init (d1);
2700  }
2701 }
void cob_mul ( cob_field *  f1,
cob_field *  f2,
const int  opt 
)

References cob_decimal_get_field(), cob_decimal_mul(), and cob_decimal_set_field().

1950 {
1951  cob_decimal_set_field (&cob_d1, f1);
1952  cob_decimal_set_field (&cob_d2, f2);
1953  cob_decimal_mul (&cob_d1, &cob_d2);
1954  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1955 }
int cob_numeric_cmp ( cob_field *  f1,
cob_field *  f2 
)

References cob_cmp_float(), cob_decimal_cmp(), cob_decimal_set_field(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_DOUBLE, and COB_TYPE_NUMERIC_FLOAT.

Referenced by cob_cmp(), cob_file_sort_compare(), and sort_compare().

2345 {
2346  if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_FLOAT
2347  || COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_DOUBLE
2348  || COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_FLOAT
2349  || COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_DOUBLE) {
2350  return cob_cmp_float(f1,f2);
2351  }
2352  cob_decimal_set_field (&cob_d1, f1);
2353  cob_decimal_set_field (&cob_d2, f2);
2354  return cob_decimal_cmp (&cob_d1, &cob_d2);
2355 }
static int cob_packed_get_sign ( const cob_field *  f)
static

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

Referenced by cob_cmp_packed(), and cob_decimal_set_packed().

911 {
912  unsigned char *p;
913 
914  if (!COB_FIELD_HAVE_SIGN (f) || COB_FIELD_NO_SIGN_NIBBLE (f)) {
915  return 0;
916  }
917  p = f->data + f->size - 1;
918  return ((*p & 0x0FU) == 0x0DU) ? -1 : 1;
919 }
void cob_print_ieeedec ( const cob_field *  f,
FILE *  fp 
)

References cob_decimal_print(), cob_decimal_set_double(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, and cob_field::data.

Referenced by display_common().

1648 {
1649  union {
1650  double dval;
1651  float fval;
1652  } uval;
1653 
1654  switch (COB_FIELD_TYPE (f)) {
1655  case COB_TYPE_NUMERIC_FP_DEC64:
1656  cob_decimal_set_ieee64dec (&cob_d3, f);
1657  break;
1658  case COB_TYPE_NUMERIC_FP_DEC128:
1659  cob_decimal_set_ieee128dec (&cob_d3, f);
1660  break;
1661  case COB_TYPE_NUMERIC_FLOAT:
1662  memcpy ((void *)&uval.fval, f->data, sizeof(float));
1663  cob_decimal_set_double (&cob_d3, (double)uval.fval);
1664  break;
1665  case COB_TYPE_NUMERIC_DOUBLE:
1666  memcpy ((void *)&uval.dval, f->data, sizeof(double));
1667  cob_decimal_set_double (&cob_d3, uval.dval);
1668  break;
1669  default:
1670  return;
1671  }
1672  cob_decimal_print (&cob_d3, fp);
1673 }
void cob_print_realbin ( const cob_field *  f,
FILE *  fp,
const int  size 
)

References CB_FMT_PLLD, CB_FMT_PLLU, cob_binary_get_sint64(), COB_FIELD_HAVE_SIGN, cob_s64_t, and cob_u64_t.

Referenced by display_common().

1677 {
1678  union {
1679  cob_u64_t uval;
1680  cob_s64_t val;
1681  } llval;
1682 
1683  if (COB_FIELD_HAVE_SIGN (f)) {
1684  llval.val = cob_binary_get_sint64 (f);
1685  fprintf (fp, CB_FMT_PLLD, size, size, llval.val);
1686  return;
1687  }
1688  llval.uval = cob_binary_get_sint64 (f);
1689  fprintf (fp, CB_FMT_PLLU, size, size, llval.uval);
1690 }
void cob_set_packed_int ( cob_field *  f,
const int  val 
)

References COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, COB_FIELD_NO_SIGN_NIBBLE, cob_set_packed_zero(), cob_u32_t, cob_field::data, p, packed_bytes, and cob_field::size.

1262 {
1263  unsigned char *p;
1264  size_t sign = 0;
1265  cob_u32_t n;
1266 
1267  if (!val) {
1268  cob_set_packed_zero (f);
1269  return;
1270  }
1271  if (val < 0) {
1272  n = (cob_u32_t)-val;
1273  sign = 1;
1274  } else {
1275  n = (cob_u32_t)val;
1276  }
1277  memset (f->data, 0, f->size);
1278  p = f->data + f->size - 1;
1279  if (!COB_FIELD_NO_SIGN_NIBBLE (f)) {
1280  *p = (n % 10) << 4;
1281  if (!COB_FIELD_HAVE_SIGN (f)) {
1282  *p |= 0x0FU;
1283  } else if (sign) {
1284  *p |= 0x0DU;
1285  } else {
1286  *p |= 0x0CU;
1287  }
1288  n /= 10;
1289  p--;
1290  }
1291  for (; n && p >= f->data; n /= 100, p--) {
1292  *p = packed_bytes[n % 100];
1293  }
1294  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
1295  if ((COB_FIELD_DIGITS(f) % 2) == 1) {
1296  *(f->data) &= 0x0FU;
1297  }
1298  return;
1299  }
1300  if ((COB_FIELD_DIGITS(f) % 2) == 0) {
1301  *(f->data) &= 0x0FU;
1302  }
1303 }
void cob_set_packed_zero ( cob_field *  f)

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

Referenced by cob_decimal_get_packed(), and cob_set_packed_int().

1074 {
1075  memset (f->data, 0, f->size);
1076  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
1077  return;
1078  }
1079  if (!COB_FIELD_HAVE_SIGN (f)) {
1080  *(f->data + f->size - 1) = 0x0F;
1081  } else {
1082  *(f->data + f->size - 1) = 0x0C;
1083  }
1084 }
void cob_sub ( cob_field *  f1,
cob_field *  f2,
const int  opt 
)

References cob_decimal_get_field(), cob_decimal_set_field(), and cob_decimal_sub().

1941 {
1942  cob_decimal_set_field (&cob_d1, f1);
1943  cob_decimal_set_field (&cob_d2, f2);
1944  cob_decimal_sub (&cob_d1, &cob_d2);
1945  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1946 }
int cob_sub_int ( cob_field *  f,
const int  n,
const int  opt 
)

References cob_add_int().

2252 {
2253  return cob_add_int (f, -n, opt);
2254 }
static COB_INLINE COB_A_INLINE void num_byte_memcpy ( unsigned char *  s1,
const unsigned char *  s2,
size_t  size 
)
static

Referenced by cob_binary_get_sint64(), cob_binary_get_uint64(), cob_binary_set_int64(), and cob_binary_set_uint64().

230 {
231  do {
232  *s1++ = *s2++;
233  } while (--size);
234 }
static void shift_decimal ( cob_decimal *  d,
const int  n 
)
static

References cob_mexp, cob_uli_t, cob_decimal::scale, and cob_decimal::value.

Referenced by align_decimal(), cob_decimal_div(), cob_decimal_do_round(), cob_decimal_get_field(), and cob_div_quotient().

395 {
396  if (n == 0) {
397  return;
398  }
399  if (n > 0) {
400  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)n);
401  mpz_mul (d->value, d->value, cob_mexp);
402  } else {
403  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-n);
404  mpz_tdiv_q (d->value, d->value, cob_mexp);
405  }
406  d->scale += n;
407 }

Variable Documentation

cob_decimal cob_d1
static

Referenced by cob_decimal_get_field().

cob_decimal cob_d2
static
cob_decimal cob_d3
static
cob_decimal cob_d_remainder
static
cob_decimal* cob_decimal_base
static

Referenced by cob_exit_numeric(), and cob_init_numeric().

mpz_t cob_mexp
static

Referenced by cob_add_int(), cob_decimal_get_double(), cob_decimal_set_double(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), cob_exit_numeric(), cob_init_numeric(), and shift_decimal().

mpf_t cob_mpft
static

Referenced by cob_decimal_get_double(), cob_decimal_set_double(), cob_exit_numeric(), and cob_init_numeric().

mpf_t cob_mpft_get
static

Referenced by cob_decimal_get_double(), cob_exit_numeric(), and cob_init_numeric().

mpz_t cob_mpz_ten16m1
static

Referenced by cob_decimal_get_ieee64dec(), cob_exit_numeric(), and cob_init_numeric().

mpz_t cob_mpz_ten34m1
static

Referenced by cob_decimal_get_ieee128dec(), cob_decimal_set_ieee128dec(), cob_exit_numeric(), and cob_init_numeric().

mpz_t cob_mpze10[COB_MAX_BINARY]
static

Referenced by cob_decimal_get_binary(), cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), cob_exit_numeric(), and cob_init_numeric().

mpz_t cob_mpzt
static

Referenced by cob_decimal_do_round(), cob_decimal_get_binary(), cob_exit_numeric(), and cob_init_numeric().

mpz_t cob_mpzt2
static

Referenced by cob_decimal_do_round(), cob_decimal_print(), cob_exit_numeric(), and cob_init_numeric().

cob_global* cobglobptr
static
cob_u64_t last_packed_val
static

Referenced by cob_cmp_packed(), and cob_init_numeric().

const unsigned char packed_bytes[]
static
Initial value:
= {
0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09,
0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19,
0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39,
0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49,
0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59,
0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69,
0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79,
0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89,
0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99
}

Referenced by cob_set_packed_int().

unsigned char packed_value[20]
static

Referenced by cob_cmp_packed(), and cob_init_numeric().