OpenCOBOL 1.1pre-rel
|
#include "config.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <math.h>
#include "common.h"
#include "coblocal.h"
#include "move.h"
#include "numeric.h"
#include "byteswap.h"
#include "codegen.h"
Go to the source code of this file.
Defines | |
#define | COB_LIB_INCLUDE |
#define | DECIMAL_NAN -128 |
#define | DECIMAL_CHECK(d1, d2) |
#define | COB_MAX_BINARY 36 |
Functions | |
static COB_INLINE void | num_byte_memcpy (unsigned char *s1, const unsigned char *s2, size_t size) |
static long long | cob_binary_get_int64 (const cob_field *const f) |
static unsigned long long | cob_binary_get_uint64 (const cob_field *const f) |
static void | cob_binary_set_uint64 (cob_field *f, unsigned long long n) |
static void | cob_binary_set_int64 (cob_field *f, long long n) |
void | cob_decimal_init (cob_decimal *d) |
static void | shift_decimal (cob_decimal *d, const int n) |
static void | align_decimal (cob_decimal *d1, cob_decimal *d2) |
static void | cob_decimal_set (cob_decimal *dst, const cob_decimal *src) |
static void | cob_decimal_set_double (cob_decimal *d, const double v) |
static double | cob_decimal_get_double (cob_decimal *d) |
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) |
static int | cob_packed_get_sign (const cob_field *f) |
static void | cob_add_packed (cob_field *f, int val) |
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_zero (cob_field *f) |
void | cob_set_packed_int (cob_field *f, const int val) |
void | cob_decimal_set_field (cob_decimal *d, cob_field *f) |
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) |
void | cob_decimal_pow (cob_decimal *d1, cob_decimal *d2) |
int | cob_decimal_cmp (cob_decimal *d1, cob_decimal *d2) |
static int | display_add_int (unsigned char *data, const size_t size, unsigned int n) |
static int | display_sub_int (unsigned char *data, const size_t size, unsigned int n) |
static int | cob_display_add_int (cob_field *f, int n) |
int | cob_add (cob_field *f1, cob_field *f2, const int opt) |
int | cob_sub (cob_field *f1, cob_field *f2, const int opt) |
int | cob_add_int (cob_field *f, const int n) |
int | cob_sub_int (cob_field *f, const int n) |
int | cob_div_quotient (cob_field *dividend, cob_field *divisor, cob_field *quotient, const int opt) |
int | cob_div_remainder (cob_field *fld_remainder, 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_numeric_cmp (cob_field *f1, cob_field *f2) |
int | cob_cmp_packed (cob_field *f, int n) |
void | cob_init_numeric (void) |
int | cob_cmp_numdisp (const unsigned char *data, const size_t size, const int n) |
int | cob_cmp_long_numdisp (const unsigned char *data, const size_t size, const int n) |
static int | cob_get_ebcdic_sign (const unsigned char *p, int *val) |
static int | cob_get_long_ebcdic_sign (const unsigned char *p, long long *val) |
int | cob_cmp_sign_numdisp (const unsigned char *data, const size_t size, const int n) |
int | cob_cmp_long_sign_numdisp (const unsigned char *data, const size_t size, const int n) |
Variables | |
static const unsigned char | packed_bytes [] |
static unsigned char * | num_buff_ptr |
static cob_decimal | cob_d1 |
static cob_decimal | cob_d2 |
static cob_decimal | cob_d3 |
static cob_decimal | cob_d4 |
static mpz_t | cob_mexp |
static mpz_t | cob_mpzt |
static mpz_t | cob_mpze10 [COB_MAX_BINARY] |
static unsigned char | packed_value [20] |
if (unlikely(d1->scale == DECIMAL_NAN || d2->scale == DECIMAL_NAN)) { \ d1->scale = DECIMAL_NAN; \ return; \ }
static void align_decimal | ( | cob_decimal * | d1, |
cob_decimal * | d2 | ||
) | [static] |
Definition at line 1215 of file numeric.c.
{ cob_decimal_set_field (&cob_d1, f1); cob_decimal_set_field (&cob_d2, f2); cob_decimal_add (&cob_d1, &cob_d2); return cob_decimal_get_field (&cob_d1, f1, opt); }
int cob_add_int | ( | cob_field * | f, |
const int | n | ||
) |
Definition at line 1233 of file numeric.c.
{ if (unlikely(n == 0)) { return 0; } switch (COB_FIELD_TYPE (f)) { case COB_TYPE_NUMERIC_DISPLAY: return cob_display_add_int (f, n); case COB_TYPE_NUMERIC_PACKED: cob_add_packed (f, n); return 0; default: /* not optimized */ cob_decimal_set_field (&cob_d1, f); mpz_set_si (cob_d2.value, n); cob_d2.scale = 0; if (cob_d1.scale) { mpz_ui_pow_ui (cob_mexp, 10, (unsigned int)cob_d1.scale); mpz_mul (cob_d2.value, cob_d2.value, cob_mexp); cob_d2.scale = cob_d1.scale; } mpz_add (cob_d1.value, cob_d1.value, cob_d2.value); return cob_decimal_get_field (&cob_d1, f, 0); } }
static void cob_add_packed | ( | cob_field * | f, |
int | val | ||
) | [static] |
Definition at line 622 of file numeric.c.
{ unsigned char *p; int sign; int ndigs; int tval; int carry = 0; unsigned int msn; unsigned int subtr = 0; unsigned int zeroes = 0; unsigned int origdigs; ndigs = COB_FIELD_DIGITS(f) - COB_FIELD_SCALE(f); if (ndigs <= 0) { return; } sign = cob_packed_get_sign (f); msn = 1 - (COB_FIELD_SCALE(f) % 2); /* -x +v = -(x - v), -x -v = -(x + v) */ if (sign < 0) { val = -val; } if (val < 0) { val = -val; subtr = 1; } p = f->data + (ndigs / 2) - (1 - msn); origdigs = ndigs; while (ndigs--) { if (!msn) { tval = *p & 0x0f; } else { tval = (*p & 0xf0) >> 4; } if (val) { carry += (val % 10); val /= 10; } if (subtr) { tval -= carry; if (tval < 0) { tval += 10; carry = 1; } else { carry = 0; } } else { tval += carry; if (tval > 9) { tval %= 10; carry = 1; } else { carry = 0; } } if (tval == 0) { zeroes++; } if (!msn) { *p = (*p & 0xf0) | tval; msn = 1; } else { *p = (*p & 0x0f) | (tval << 4); msn = 0; p--; } } if (sign) { p = f->data + f->size - 1; if (origdigs == zeroes) { *p = (*p & 0xf0) | 0x0c; } else if (subtr && carry) { sign = -sign; if (sign < 0) { *p = (*p & 0xf0) | 0x0d; } else { *p = (*p & 0xf0) | 0x0c; } } } }
static long long cob_binary_get_int64 | ( | const cob_field *const | f | ) | [static] |
Definition at line 165 of file numeric.c.
{ long long n = 0; size_t fsiz = 8 - f->size; /* Experimental code - not activated */ #if 0 unsigned char *s; if ((COB_FIELD_BINARY_SWAP (f) && !COB_FIELD_HAVE_SIGN (f)) || (!COB_FIELD_BINARY_SWAP (f) && COB_FIELD_HAVE_SIGN (f))) { s = (unsigned char *)&n + fsiz; } else { s = (unsigned char *)&n; } num_byte_memcpy (s, f->data, f->size); if (COB_FIELD_BINARY_SWAP (f)) { n = COB_BSWAP_64 (n); } if (COB_FIELD_HAVE_SIGN (f)) { n >>= 8 * fsiz; /* shift with sign */ } #endif #ifndef WORDS_BIGENDIAN if (COB_FIELD_BINARY_SWAP (f)) { if (COB_FIELD_HAVE_SIGN (f)) { num_byte_memcpy ((unsigned char *)&n, f->data, f->size); n = COB_BSWAP_64 (n); n >>= 8 * fsiz; /* shift with sign */ } else { num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); n = COB_BSWAP_64 (n); } } else { if (COB_FIELD_HAVE_SIGN (f)) { num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); n >>= 8 * fsiz; /* shift with sign */ } else { num_byte_memcpy ((unsigned char *)&n, f->data, f->size); } } #else /* WORDS_BIGENDIAN */ if (COB_FIELD_HAVE_SIGN (f)) { num_byte_memcpy ((unsigned char *)&n, f->data, f->size); n >>= 8 * fsiz; /* shift with sign */ } else { num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); } #endif /* WORDS_BIGENDIAN */ return n; }
static unsigned long long cob_binary_get_uint64 | ( | const cob_field *const | f | ) | [static] |
Definition at line 218 of file numeric.c.
{ unsigned long long n = 0; size_t fsiz = 8 - f->size; #ifndef WORDS_BIGENDIAN if (COB_FIELD_BINARY_SWAP (f)) { num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); n = COB_BSWAP_64 (n); } else { num_byte_memcpy ((unsigned char *)&n, f->data, f->size); } #else /* WORDS_BIGENDIAN */ num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); #endif /* WORDS_BIGENDIAN */ return n; }
static void cob_binary_set_int64 | ( | cob_field * | f, |
long long | n | ||
) | [static] |
Definition at line 255 of file numeric.c.
{ #ifndef WORDS_BIGENDIAN unsigned char *s; if (COB_FIELD_BINARY_SWAP (f)) { n = COB_BSWAP_64 (n); s = ((unsigned char *)&n) + 8 - f->size; } else { s = (unsigned char *)&n; } num_byte_memcpy (f->data, s, f->size); #else /* WORDS_BIGENDIAN */ num_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size); #endif /* WORDS_BIGENDIAN */ }
static void cob_binary_set_uint64 | ( | cob_field * | f, |
unsigned long long | n | ||
) | [static] |
Definition at line 237 of file numeric.c.
{ #ifndef WORDS_BIGENDIAN unsigned char *s; if (COB_FIELD_BINARY_SWAP (f)) { n = COB_BSWAP_64 (n); s = ((unsigned char *)&n) + 8 - f->size; } else { s = (unsigned char *)&n; } num_byte_memcpy (f->data, s, f->size); #else /* WORDS_BIGENDIAN */ num_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size); #endif /* WORDS_BIGENDIAN */ }
int cob_cmp_int | ( | cob_field * | f1, |
const int | n | ||
) |
int cob_cmp_long_numdisp | ( | const unsigned char * | data, |
const size_t | size, | ||
const int | n | ||
) |
int cob_cmp_long_sign_numdisp | ( | const unsigned char * | data, |
const size_t | size, | ||
const int | n | ||
) |
Definition at line 1682 of file numeric.c.
{ const unsigned char *p; long long val = 0; size_t inc; p = data; for (inc = 0; inc < size - 1; inc++, p++) { val = (val * 10) + (*p - (unsigned char)'0'); } val *= 10; if (*p >= '0' && *p <= '9') { val += (*p - (unsigned char)'0'); } else { if (unlikely(cob_current_module->display_sign)) { if (cob_get_long_ebcdic_sign (p, &val)) { val = -val; } } else { #ifdef COB_EBCDIC_MACHINE cob_get_long_ascii_sign (p, &val); #else val += (*p - (unsigned char)'p'); #endif val = -val; } } return (val < n) ? -1 : (val > n); }
int cob_cmp_numdisp | ( | const unsigned char * | data, |
const size_t | size, | ||
const int | n | ||
) |
int cob_cmp_packed | ( | cob_field * | f, |
int | n | ||
) |
Definition at line 1332 of file numeric.c.
{ static int lastval = 0; unsigned char *p; size_t size; size_t inc = 0; int sign; unsigned char val1[20]; sign = cob_packed_get_sign (f); /* Field positive, value negative */ if (sign >= 0 && n < 0) { return 1; } /* Field negative, value positive */ if (sign < 0 && n >= 0) { return -1; } /* Both positive or both negative */ p = f->data; for (size = 0; size < 20; size++) { if (size < 20 - f->size) { val1[size] = 0; } else { val1[size] = p[inc++]; } } val1[19] &= 0xf0; if ((COB_FIELD_DIGITS(f) % 2) == 0) { val1[20 - f->size] &= 0x0f; } if (n != lastval) { lastval = n; if (n < 0) { n = -n; } memset (&packed_value[14], 0, 6); if (n) { p = &packed_value[19]; *p = (n % 10) << 4; p--; n /= 10; for (; n;) { size = n % 100; *p = (unsigned char)((size % 10) | ((size / 10) << 4)); n /= 100; p--; } } } for (size = 0; size < 20; size++) { if (val1[size] != packed_value[size]) { if (sign < 0) { return packed_value[size] - val1[size]; } else { return val1[size] - packed_value[size]; } } } return 0; }
int cob_cmp_sign_numdisp | ( | const unsigned char * | data, |
const size_t | size, | ||
const int | n | ||
) |
Definition at line 1651 of file numeric.c.
{ const unsigned char *p; int val = 0; size_t inc; p = data; for (inc = 0; inc < size - 1; inc++, p++) { val = (val * 10) + (*p - (unsigned char)'0'); } val *= 10; if (*p >= '0' && *p <= '9') { val += (*p - (unsigned char)'0'); } else { if (unlikely(cob_current_module->display_sign)) { if (cob_get_ebcdic_sign (p, &val)) { val = -val; } } else { #ifdef COB_EBCDIC_MACHINE cob_get_ascii_sign (p, &val); #else val += (*p - (unsigned char)'p'); #endif val = -val; } } return (val < n) ? -1 : (val > n); }
int cob_cmp_uint | ( | cob_field * | f1, |
const unsigned int | n | ||
) |
void cob_decimal_add | ( | cob_decimal * | d1, |
cob_decimal * | d2 | ||
) |
Definition at line 982 of file numeric.c.
{ DECIMAL_CHECK (d1, d2); align_decimal (d1, d2); mpz_add (d1->value, d1->value, d2->value); }
int cob_decimal_cmp | ( | cob_decimal * | d1, |
cob_decimal * | d2 | ||
) |
Definition at line 1043 of file numeric.c.
{ align_decimal (d1, d2); return mpz_cmp (d1->value, d2->value); }
void cob_decimal_div | ( | cob_decimal * | d1, |
cob_decimal * | d2 | ||
) |
Definition at line 1006 of file numeric.c.
{ DECIMAL_CHECK (d1, d2); /* check for division by zero */ if (unlikely(mpz_sgn (d2->value) == 0)) { d1->scale = DECIMAL_NAN; cob_set_exception (COB_EC_SIZE_ZERO_DIVIDE); return; } if (unlikely(mpz_sgn (d1->value) == 0)) { d1->scale = 0; return; } d1->scale -= d2->scale; shift_decimal (d1, 37 + ((d1->scale < 0) ? -d1->scale : 0)); mpz_tdiv_q (d1->value, d1->value, d2->value); }
static int cob_decimal_get_binary | ( | cob_decimal * | d, |
cob_field * | f, | ||
const int | opt | ||
) | [static] |
Definition at line 502 of file numeric.c.
{ size_t overflow; size_t digits; size_t sign; size_t bitnum; #if !defined(COB_EXPERIMENTAL) && !defined(COB_LI_IS_LL) long long llval; unsigned long long ullval; unsigned int lo; #endif if (unlikely(mpz_size (d->value) == 0)) { memset (f->data, 0, f->size); return 0; } overflow = 0; digits = COB_FIELD_DIGITS(f); if (COB_FIELD_HAVE_SIGN (f)) { sign = 1; } else { sign = 0; if (mpz_sgn (d->value) < 0) { mpz_abs (d->value, d->value); } } bitnum = (f->size * 8) - sign; if (unlikely(mpz_sizeinbase (d->value, 2) > bitnum)) { if (opt & COB_STORE_KEEP_ON_OVERFLOW) { goto overflow; } overflow = 1; /* TRUNC_ON_OVERFLOW is only set for binary_truncate */ if (opt & COB_STORE_TRUNC_ON_OVERFLOW) { mpz_tdiv_r (d->value, d->value, cob_mpze10[digits]); /* } */ /* RXW */ } else { mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8)); } } else if (opt && cob_current_module->flag_binary_truncate) { if (mpz_cmpabs (d->value, cob_mpze10[digits]) >= 0) { /* overflow */ if (opt & COB_STORE_KEEP_ON_OVERFLOW) { goto overflow; } overflow = 1; /* TRUNC_ON_OVERFLOW is only set for binary_truncate */ if (opt & COB_STORE_TRUNC_ON_OVERFLOW) { mpz_tdiv_r (d->value, d->value, cob_mpze10[digits]); /* } */ /* RXW */ } else { mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8)); } } } #ifdef COB_LI_IS_LL if (!sign || overflow) { cob_binary_set_uint64 (f, mpz_get_ui (d->value)); } else { cob_binary_set_int64 (f, mpz_get_si (d->value)); } #elif defined(COB_EXPERIMENTAL) if (!sign || overflow) { cob_binary_set_uint64 (f, mpz_get_ull (d->value)); } else { cob_binary_set_int64 (f, mpz_get_sll (d->value)); } #else if (f->size <= 4) { if (!sign || overflow) { cob_binary_set_uint64 (f, (unsigned long long)mpz_get_ui (d->value)); } else { cob_binary_set_int64 (f, (long long)mpz_get_si (d->value)); } } else { mpz_fdiv_r_2exp (cob_mpzt, d->value, 32); mpz_fdiv_q_2exp (d->value, d->value, 32); lo = mpz_get_ui (cob_mpzt); if (!sign || overflow) { ullval = mpz_get_ui (d->value); ullval = (ullval << 32) | lo; cob_binary_set_uint64 (f, ullval); } else { llval = mpz_get_si (d->value); llval = (llval << 32) | lo; cob_binary_set_int64 (f, llval); } } #endif if (!overflow) { return 0; } overflow: cob_set_exception (COB_EC_SIZE_OVERFLOW); return cob_exception_code; }
static int cob_decimal_get_display | ( | cob_decimal * | d, |
cob_field * | f, | ||
const int | opt | ||
) | [static] |
Definition at line 411 of file numeric.c.
{ unsigned char *data; size_t size; int diff; int sign; /* build string */ sign = mpz_sgn (d->value); mpz_abs (d->value, d->value); mpz_get_str ((char *)num_buff_ptr, 10, d->value); size = strlen ((char *)num_buff_ptr); /* store number */ data = COB_FIELD_DATA (f); diff = (int)(COB_FIELD_SIZE (f) - size); if (unlikely(diff < 0)) { /* overflow */ cob_set_exception (COB_EC_SIZE_OVERFLOW); /* if the statement has ON SIZE ERROR or NOT ON SIZE ERROR, then throw an exception */ if (opt & COB_STORE_KEEP_ON_OVERFLOW) { return cob_exception_code; } /* othersize, truncate digits */ memcpy (data, num_buff_ptr - diff, COB_FIELD_SIZE (f)); } else { /* no overflow */ memset (data, '0', (size_t)diff); memcpy (data + diff, num_buff_ptr, size); } cob_put_sign (f, sign); return 0; }
static double cob_decimal_get_double | ( | cob_decimal * | d | ) | [static] |
int cob_decimal_get_field | ( | cob_decimal * | d, |
cob_field * | f, | ||
const int | opt | ||
) |
Definition at line 910 of file numeric.c.
{ cob_field temp; cob_field_attr attr; double val; float fval; int sign; unsigned char data[64]; if (unlikely(d->scale == DECIMAL_NAN)) { cob_set_exception (COB_EC_SIZE_OVERFLOW); return cob_exception_code; } /* work copy */ if (d != &cob_d1) { cob_decimal_set (&cob_d1, d); d = &cob_d1; } /* rounding */ if (opt & COB_STORE_ROUND) { if (COB_FIELD_SCALE(f) < d->scale) { sign = mpz_sgn (d->value); if (sign != 0) { shift_decimal (d, COB_FIELD_SCALE(f) - d->scale + 1); if (sign > 0) { mpz_add_ui (d->value, d->value, 5); } else { mpz_sub_ui (d->value, d->value, 5); } } } } /* append or truncate decimal digits */ shift_decimal (d, COB_FIELD_SCALE(f) - d->scale); /* store number */ switch (COB_FIELD_TYPE (f)) { case COB_TYPE_NUMERIC_BINARY: return cob_decimal_get_binary (d, f, opt); case COB_TYPE_NUMERIC_PACKED: return cob_decimal_get_packed (d, f, opt); case COB_TYPE_NUMERIC_DISPLAY: return cob_decimal_get_display (d, f, opt); case COB_TYPE_NUMERIC_FLOAT: fval = (float) cob_decimal_get_double (d); memcpy (f->data, (ucharptr)&fval, sizeof (float)); return 0; case COB_TYPE_NUMERIC_DOUBLE: val = cob_decimal_get_double (d); memcpy (f->data, (ucharptr)&val, sizeof (double)); return 0; default: COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, COB_FIELD_DIGITS(f), COB_FIELD_SCALE(f), COB_FLAG_HAVE_SIGN, NULL); temp.size = COB_FIELD_DIGITS(f); temp.data = data; temp.attr = &attr; if (cob_decimal_get_display (d, &temp, opt) == 0) { cob_move (&temp, f); } return cob_exception_code; } }
static int cob_decimal_get_packed | ( | cob_decimal * | d, |
cob_field * | f, | ||
const int | opt | ||
) | [static] |
Definition at line 774 of file numeric.c.
{ unsigned char *data; unsigned char *p; unsigned char *q; size_t size; size_t n; size_t i; int diff; int sign; int digits; unsigned char x; /* build string */ sign = mpz_sgn (d->value); mpz_abs (d->value, d->value); mpz_get_str ((char *)num_buff_ptr, 10, d->value); size = strlen ((char *)num_buff_ptr); /* store number */ data = f->data; /* Fixme */ digits = COB_FIELD_DIGITS(f); q = num_buff_ptr; diff = (int)(digits - size); if (diff < 0) { /* overflow */ cob_set_exception (COB_EC_SIZE_OVERFLOW); /* if the statement has ON SIZE ERROR or NOT ON SIZE ERROR, then throw an exception */ if (opt & COB_STORE_KEEP_ON_OVERFLOW) { return cob_exception_code; } q += size - digits; size = digits; } memset (data, 0, f->size); p = data + (digits / 2) - (size / 2); diff = 1 - (int)(size % 2); for (i = diff, n = 0; i < size + diff; i++, n++) { x = cob_d2i (q[n]); if (i % 2 == 0) { *p = x << 4; } else { *p++ |= x; } } p = f->data + f->size - 1; if (!COB_FIELD_HAVE_SIGN (f)) { *p = (*p & 0xf0) | 0x0f; } else if (sign < 0) { *p = (*p & 0xf0) | 0x0d; } else { *p = (*p & 0xf0) | 0x0c; } return 0; }
void cob_decimal_init | ( | cob_decimal * | d | ) |
void cob_decimal_mul | ( | cob_decimal * | d1, |
cob_decimal * | d2 | ||
) |
void cob_decimal_pow | ( | cob_decimal * | d1, |
cob_decimal * | d2 | ||
) |
Definition at line 1026 of file numeric.c.
{ unsigned int n; DECIMAL_CHECK (d1, d2); if (d2->scale == 0 && mpz_fits_ulong_p (d2->value)) { n = mpz_get_ui (d2->value); mpz_pow_ui (d1->value, d1->value, n); d1->scale *= n; } else { cob_decimal_set_double (d1, pow (cob_decimal_get_double (d1), cob_decimal_get_double (d2))); } }
static void cob_decimal_set | ( | cob_decimal * | dst, |
const cob_decimal * | src | ||
) | [static] |
static void cob_decimal_set_binary | ( | cob_decimal * | d, |
cob_field * | f | ||
) | [static] |
Definition at line 452 of file numeric.c.
{ #ifdef COB_LI_IS_LL if (COB_FIELD_HAVE_SIGN (f)) { mpz_set_si (d->value, cob_binary_get_int64 (f)); } else { mpz_set_ui (d->value, cob_binary_get_uint64 (f)); } #elif defined(COB_EXPERIMENTAL) if (COB_FIELD_HAVE_SIGN (f)) { mpz_set_sll (d->value, cob_binary_get_int64 (f)); } else { mpz_set_ull (d->value, cob_binary_get_uint64 (f)); } #else size_t negative = 0; unsigned long long uval; long long val; if (f->size <= 4) { if (COB_FIELD_HAVE_SIGN (f)) { mpz_set_si (d->value, (int)cob_binary_get_int64 (f)); } else { mpz_set_ui (d->value, (unsigned int) cob_binary_get_uint64 (f)); } } else { if (COB_FIELD_HAVE_SIGN (f)) { val = cob_binary_get_int64 (f); if (val < 0) { negative = 1; val = -val; } mpz_set_ui (d->value, (unsigned int)((val & 0x7FFFFFFF00000000LL)>> 32)); mpz_mul_2exp (d->value, d->value, 32); mpz_add_ui (d->value, d->value, (unsigned int)(val & 0xffffffff)); if (negative) { mpz_neg (d->value, d->value); } } else { uval = cob_binary_get_uint64 (f); mpz_set_ui (d->value, (unsigned int)(uval >> 32)); mpz_mul_2exp (d->value, d->value, 32); mpz_add_ui (d->value, d->value, (unsigned int)(uval & 0xffffffff)); } } #endif d->scale = COB_FIELD_SCALE(f); }
static void cob_decimal_set_display | ( | cob_decimal * | d, |
cob_field * | f | ||
) | [static] |
Definition at line 362 of file numeric.c.
{ unsigned char *data; size_t size; int sign; unsigned int n; data = COB_FIELD_DATA (f); size = COB_FIELD_SIZE (f); if (unlikely(*data == 255)) { mpz_ui_pow_ui (d->value, 10, size); d->scale = COB_FIELD_SCALE(f); return; } if (unlikely(*data == 0)) { mpz_ui_pow_ui (d->value, 10, size); mpz_neg (d->value, d->value); d->scale = COB_FIELD_SCALE(f); return; } sign = cob_get_sign (f); /* skip leading zeros */ while (size > 1 && *data == '0') { size--; data++; } /* set value */ if (size < 10) { n = 0; while (size--) { n = n * 10 + cob_d2i (*data++); } mpz_set_ui (d->value, n); } else { memcpy (num_buff_ptr, data, size); num_buff_ptr[size] = 0; mpz_set_str (d->value, (char *)num_buff_ptr, 10); } /* set sign and scale */ if (sign < 0) { mpz_neg (d->value, d->value); } d->scale = COB_FIELD_SCALE(f); cob_put_sign (f, sign); }
static void cob_decimal_set_double | ( | cob_decimal * | d, |
const double | v | ||
) | [static] |
void cob_decimal_set_field | ( | cob_decimal * | d, |
cob_field * | f | ||
) |
Definition at line 883 of file numeric.c.
{ double dval; float fval; switch (COB_FIELD_TYPE (f)) { case COB_TYPE_NUMERIC_BINARY: cob_decimal_set_binary (d, f); break; case COB_TYPE_NUMERIC_PACKED: cob_decimal_set_packed (d, f); break; case COB_TYPE_NUMERIC_FLOAT: memcpy ((ucharptr)&fval, f->data, sizeof(float)); cob_decimal_set_double (d, (double)fval); break; case COB_TYPE_NUMERIC_DOUBLE: memcpy ((ucharptr)&dval, f->data, sizeof(double)); cob_decimal_set_double (d, dval); break; default: cob_decimal_set_display (d, f); break; } }
static void cob_decimal_set_packed | ( | cob_decimal * | d, |
cob_field * | f | ||
) | [static] |
Definition at line 706 of file numeric.c.
{ unsigned char *p; int digits; int sign; unsigned int val; unsigned int valseen; p = f->data; /* Fixme */ digits = COB_FIELD_DIGITS (f); sign = cob_packed_get_sign (f); if (digits % 2 == 0) { val = *p & 0x0f; digits--; p++; } else { val = 0; } if (COB_FIELD_DIGITS(f) < 10) { while (digits > 1) { if (val) { val *= 100; } if (*p) { val += ((*p >> 4) * 10) + (*p & 0x0f); } digits -= 2; p++; } if (val) { val *= 10; } val += *p >> 4; mpz_set_ui (d->value, val); } else { valseen = 0; mpz_set_ui (d->value, val); if (val) { valseen = 1; } while (digits > 1) { if (valseen) { mpz_mul_ui (d->value, d->value, 100); } if (*p) { mpz_add_ui (d->value, d->value, (*p >> 4) * 10 + (*p & 0x0f)); valseen = 1; } digits -= 2; p++; } if (valseen) { mpz_mul_ui (d->value, d->value, 10); } mpz_add_ui (d->value, d->value, (*p >> 4)); } if (sign < 0) { mpz_neg (d->value, d->value); } d->scale = COB_FIELD_SCALE(f); }
void cob_decimal_sub | ( | cob_decimal * | d1, |
cob_decimal * | d2 | ||
) |
Definition at line 990 of file numeric.c.
{ DECIMAL_CHECK (d1, d2); align_decimal (d1, d2); mpz_sub (d1->value, d1->value, d2->value); }
static int cob_display_add_int | ( | cob_field * | f, |
int | n | ||
) | [static] |
Definition at line 1141 of file numeric.c.
{ unsigned char *data; size_t osize; size_t i; size_t size; int scale; int sign; unsigned char tfield[64]; data = COB_FIELD_DATA (f); size = COB_FIELD_SIZE (f); scale = COB_FIELD_SCALE (f); sign = cob_get_sign (f); osize = size; memcpy (tfield, data, osize); /* -x + n = -(x - n) */ if (sign < 0) { n = -n; } if (unlikely(scale < 0)) { /* PIC 9(n)P(m) */ if (-scale < 10) { while (scale++) { n /= 10; } } else { n = 0; } } else { /* PIC 9(n)V9(m) */ size -= scale; /* Following can never be true as size is unsigned ?? */ /* Comment out if (size < 0) { cob_put_sign (f, sign); goto overflow; } */ } if (n > 0) { /* add n to the field */ if (display_add_int (data, size, n) != 0) { /* if there was an overflow, recover the last value */ memcpy (data, tfield, osize); goto overflow; } } else if (n < 0) { /* subtract n from the field */ if (display_sub_int (data, size, -n) != 0) { for (i = 0; i < size; i++) { data[i] = cob_i2d (9 - cob_d2i (data[i])); } display_add_int (data, size, 1); sign = -sign; } } cob_put_sign (f, sign); return 0; overflow: cob_put_sign (f, sign); cob_set_exception (COB_EC_SIZE_OVERFLOW); return cob_exception_code; }
int cob_div_quotient | ( | cob_field * | dividend, |
cob_field * | divisor, | ||
cob_field * | quotient, | ||
const int | opt | ||
) |
Definition at line 1269 of file numeric.c.
{ int ret; cob_decimal_set_field (&cob_d1, dividend); cob_decimal_set_field (&cob_d2, divisor); cob_decimal_set (&cob_d3, &cob_d1); /* compute quotient */ cob_decimal_div (&cob_d1, &cob_d2); if (cob_d1.scale == DECIMAL_NAN) { cob_d3.scale = DECIMAL_NAN; return cob_exception_code; } /* set quotient */ cob_decimal_set (&cob_d4, &cob_d1); ret = cob_decimal_get_field (&cob_d1, quotient, opt); /* truncate digits from the quotient */ shift_decimal (&cob_d4, COB_FIELD_SCALE(quotient) - cob_d4.scale); /* compute remainder */ cob_decimal_mul (&cob_d4, &cob_d2); cob_decimal_sub (&cob_d3, &cob_d4); return ret; }
int cob_div_remainder | ( | cob_field * | fld_remainder, |
const int | opt | ||
) |
Definition at line 1300 of file numeric.c.
{ return cob_decimal_get_field (&cob_d3, fld_remainder, opt); }
static int cob_get_ebcdic_sign | ( | const unsigned char * | p, |
int * | val | ||
) | [static] |
Definition at line 1519 of file numeric.c.
{ switch (*p) { case '{': return 0; case 'A': *val += 1; return 0; case 'B': *val += 2; return 0; case 'C': *val += 3; return 0; case 'D': *val += 4; return 0; case 'E': *val += 5; return 0; case 'F': *val += 6; return 0; case 'G': *val += 7; return 0; case 'H': *val += 8; return 0; case 'I': *val += 9; return 0; case '}': return 1; case 'J': *val += 1; return 1; case 'K': *val += 2; return 1; case 'L': *val += 3; return 1; case 'M': *val += 4; return 1; case 'N': *val += 5; return 1; case 'O': *val += 6; return 1; case 'P': *val += 7; return 1; case 'Q': *val += 8; return 1; case 'R': *val += 9; return 1; } return 0; }
static int cob_get_long_ebcdic_sign | ( | const unsigned char * | p, |
long long * | val | ||
) | [static] |
Definition at line 1585 of file numeric.c.
{ switch (*p) { case '{': return 0; case 'A': *val += 1; return 0; case 'B': *val += 2; return 0; case 'C': *val += 3; return 0; case 'D': *val += 4; return 0; case 'E': *val += 5; return 0; case 'F': *val += 6; return 0; case 'G': *val += 7; return 0; case 'H': *val += 8; return 0; case 'I': *val += 9; return 0; case '}': return 1; case 'J': *val += 1; return 1; case 'K': *val += 2; return 1; case 'L': *val += 3; return 1; case 'M': *val += 4; return 1; case 'N': *val += 5; return 1; case 'O': *val += 6; return 1; case 'P': *val += 7; return 1; case 'Q': *val += 8; return 1; case 'R': *val += 9; return 1; } return 0; }
void cob_init_numeric | ( | void | ) |
Definition at line 1396 of file numeric.c.
{ size_t i; cob_decimal_init (&cob_d1); cob_decimal_init (&cob_d2); cob_decimal_init (&cob_d3); cob_decimal_init (&cob_d4); mpz_init2 (cob_mpzt, 256); mpz_init2 (cob_mexp, 512); for (i = 0; i < COB_MAX_BINARY; i++) { mpz_init (cob_mpze10[i]); mpz_ui_pow_ui (cob_mpze10[i], 10, i); } num_buff_ptr = cob_malloc (2048); memset (packed_value, 0, sizeof(packed_value)); }
Definition at line 1324 of file numeric.c.
{ cob_decimal_set_field (&cob_d1, f1); cob_decimal_set_field (&cob_d2, f2); return cob_decimal_cmp (&cob_d1, &cob_d2); }
static int cob_packed_get_sign | ( | const cob_field * | f | ) | [static] |
Definition at line 610 of file numeric.c.
{ unsigned char *p; if (!COB_FIELD_HAVE_SIGN (f)) { return 0; } p = f->data + f->size - 1; return ((*p & 0x0f) == 0x0d) ? -1 : 1; }
void cob_set_packed_int | ( | cob_field * | f, |
const int | val | ||
) |
Definition at line 847 of file numeric.c.
{ unsigned char *p; size_t sign = 0; int n; if (val < 0) { n = -val; sign = 1; } else { n = val; } memset (f->data, 0, f->size); p = f->data + f->size - 1; *p = (n % 10) << 4; if (!COB_FIELD_HAVE_SIGN (f)) { *p |= 0x0f; } else if (sign) { *p |= 0x0d; } else { *p |= 0x0c; } n /= 10; p--; for (; n && p >= f->data; n /= 100, p--) { *p = packed_bytes[n % 100]; } /* Fixme */ if ((COB_FIELD_DIGITS(f) % 2) == 0) { *(f->data) &= 0x0f; } }
void cob_set_packed_zero | ( | cob_field * | f | ) |
Definition at line 1224 of file numeric.c.
{ cob_decimal_set_field (&cob_d1, f1); cob_decimal_set_field (&cob_d2, f2); cob_decimal_sub (&cob_d1, &cob_d2); return cob_decimal_get_field (&cob_d1, f1, opt); }
int cob_sub_int | ( | cob_field * | f, |
const int | n | ||
) |
Definition at line 1260 of file numeric.c.
{ if (unlikely(n == 0)) { return 0; } return cob_add_int (f, -n); }
static int display_add_int | ( | unsigned char * | data, |
const size_t | size, | ||
unsigned int | n | ||
) | [static] |
Definition at line 1054 of file numeric.c.
{ unsigned char *sp; size_t carry = 0; int i; int is; sp = data + size; while (n > 0) { i = n % 10; n /= 10; /* check for overflow */ if (unlikely(--sp < data)) { if (!cob_current_module->flag_binary_truncate) { return 0; } return 1; } /* perform addition */ is = (*sp & 0x0F) + i + carry; if (is > 9) { carry = 1; *sp = '0' + (is % 10); } else { carry = 0; *sp = '0' + is; } } if (carry == 0) { return 0; } /* carry up */ while (--sp >= data) { if ((*sp += 1) <= '9') { return 0; } *sp = '0'; } if (!cob_current_module->flag_binary_truncate) { return 0; } return 1; }
static int display_sub_int | ( | unsigned char * | data, |
const size_t | size, | ||
unsigned int | n | ||
) | [static] |
Definition at line 1102 of file numeric.c.
{ unsigned char *sp; size_t carry = 0; int i; sp = data + size; while (n > 0) { i = n % 10; n /= 10; /* check for overflow */ if (unlikely(--sp < data)) { return 1; } /* perform subtraction */ if ((*sp -= i + carry) < '0') { carry = 1; *sp += 10; } else { carry = 0; } } if (carry == 0) { return 0; } /* carry up */ while (--sp >= data) { if ((*sp -= 1) >= '0') { return 0; } *sp = '9'; } return 1; }
static COB_INLINE void num_byte_memcpy | ( | unsigned char * | s1, |
const unsigned char * | s2, | ||
size_t | size | ||
) | [static] |
static void shift_decimal | ( | cob_decimal * | d, |
const int | n | ||
) | [static] |
Definition at line 297 of file numeric.c.
{ if (n == 0) { return; } if (n > 0) { mpz_ui_pow_ui (cob_mexp, 10, n); mpz_mul (d->value, d->value, cob_mexp); } else { mpz_ui_pow_ui (cob_mexp, 10, -n); mpz_tdiv_q (d->value, d->value, cob_mexp); } d->scale += n; }
cob_decimal cob_d1 [static] |
cob_decimal cob_d2 [static] |
cob_decimal cob_d3 [static] |
cob_decimal cob_d4 [static] |
mpz_t cob_mpze10[COB_MAX_BINARY] [static] |
unsigned char* num_buff_ptr [static] |
const unsigned char packed_bytes[] [static] |
{ 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 }
unsigned char packed_value[20] [static] |