|
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 | |
| void | cob_decimal_init (cob_decimal *d) |
| 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) |
| 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) |
| 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) |
| #define DECIMAL_CHECK | ( | d1, | |
| d2 | |||
| ) |
if (unlikely(d1->scale == DECIMAL_NAN || d2->scale == DECIMAL_NAN)) { \ d1->scale = DECIMAL_NAN; \ return; \ }
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);
}
}


| int cob_cmp_int | ( | cob_field * | f1, |
| const int | n | ||
| ) |
Definition at line 1306 of file numeric.c.
{
cob_decimal_set_field (&cob_d1, f1);
mpz_set_si (cob_d2.value, n);
cob_d2.scale = 0;
return cob_decimal_cmp (&cob_d1, &cob_d2);
}

| 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 | ||
| ) |
Definition at line 1315 of file numeric.c.
{
cob_decimal_set_field (&cob_d1, f1);
mpz_set_ui (cob_d2.value, n);
cob_d2.scale = 0;
return cob_decimal_cmp (&cob_d1, &cob_d2);
}

| void cob_decimal_add | ( | cob_decimal * | d1, |
| cob_decimal * | d2 | ||
| ) |
| int cob_decimal_cmp | ( | cob_decimal * | d1, |
| cob_decimal * | d2 | ||
| ) |
| 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);
}


| 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;
}
}


| 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)));
}
}

| 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;
}
}

| void cob_decimal_sub | ( | cob_decimal * | d1, |
| cob_decimal * | d2 | ||
| ) |
| 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);
}

| 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);
}

| 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);
}

1.7.4