OpenCOBOL 1.1pre-rel
|
Go to the source code of this file.
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 * | , |
const int | |||
) |
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); } }
int cob_cmp_int | ( | cob_field * | , |
const int | |||
) |
int cob_cmp_long_numdisp | ( | const unsigned char * | , |
const size_t | , | ||
const int | |||
) |
int cob_cmp_long_sign_numdisp | ( | const unsigned char * | , |
const size_t | , | ||
const int | |||
) |
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 * | , |
const size_t | , | ||
const int | |||
) |
int cob_cmp_packed | ( | cob_field * | , |
int | |||
) |
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 * | , |
const size_t | , | ||
const int | |||
) |
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 * | , |
const unsigned | int | ||
) |
void cob_decimal_add | ( | cob_decimal * | , |
cob_decimal * | |||
) |
int cob_decimal_cmp | ( | cob_decimal * | , |
cob_decimal * | |||
) |
void cob_decimal_div | ( | cob_decimal * | , |
cob_decimal * | |||
) |
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); }
int cob_decimal_get_field | ( | cob_decimal * | , |
cob_field * | , | ||
const int | |||
) |
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; } }
void cob_decimal_init | ( | cob_decimal * | ) |
void cob_decimal_mul | ( | cob_decimal * | , |
cob_decimal * | |||
) |
void cob_decimal_pow | ( | cob_decimal * | , |
cob_decimal * | |||
) |
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))); } }
void cob_decimal_set_field | ( | cob_decimal * | , |
cob_field * | |||
) |
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; } }
void cob_decimal_sub | ( | cob_decimal * | , |
cob_decimal * | |||
) |
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 * | , |
const int | |||
) |
Definition at line 1300 of file numeric.c.
{ return cob_decimal_get_field (&cob_d3, fld_remainder, opt); }
void cob_set_packed_int | ( | cob_field * | , |
const int | |||
) |
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 * | ) |
Definition at line 836 of file numeric.c.
{ memset (f->data, 0, f->size); if (!COB_FIELD_HAVE_SIGN (f)) { *(f->data + f->size - 1) = 0x0f; } else { *(f->data + f->size - 1) = 0x0c; } }
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 * | , |
const int | |||
) |
Definition at line 1260 of file numeric.c.
{ if (unlikely(n == 0)) { return 0; } return cob_add_int (f, -n); }