OpenCOBOL 1.1pre-rel
Defines | Functions
numeric.c File Reference
#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"
Include dependency graph for numeric.c:

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 Documentation

#define COB_LIB_INCLUDE

Definition at line 35 of file numeric.c.

#define COB_MAX_BINARY   36

Definition at line 45 of file numeric.c.

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

Definition at line 39 of file numeric.c.

#define DECIMAL_NAN   -128

Definition at line 38 of file numeric.c.


Function Documentation

int cob_add ( cob_field f1,
cob_field f2,
const int  opt 
)

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

Here is the call graph for this function:

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Here is the call graph for this function:

int cob_cmp_long_numdisp ( const unsigned char *  data,
const size_t  size,
const int  n 
)

Definition at line 1431 of file numeric.c.

{
        const unsigned char     *p;
        long long               val = 0;
        size_t                  inc;

        p = data;
        for (inc = 0; inc < size; inc++, p++) {
                val = (val * 10) + (*p - (unsigned char)'0');
        }
        return (val < n) ? -1 : (val > 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 
)

Definition at line 1417 of file numeric.c.

{
        const unsigned char     *p;
        size_t                  inc;
        int                     val = 0;

        p = data;
        for (inc = 0; inc < size; inc++, p++) {
                val = (val * 10) + (*p - (unsigned char)'0');
        }
        return (val < n) ? -1 : (val > 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);
}

Here is the call graph for this function:

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

Here is the caller graph for this function:

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

Here is the caller graph for this function:

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_decimal_init ( cob_decimal d)

Definition at line 277 of file numeric.c.

{
        mpz_init2 (d->value, 256);
        d->scale = 0;
}

Here is the caller graph for this function:

void cob_decimal_mul ( cob_decimal d1,
cob_decimal d2 
)

Definition at line 998 of file numeric.c.

{
        DECIMAL_CHECK (d1, d2);
        d1->scale += d2->scale;
        mpz_mul (d1->value, d1->value, d2->value);
}

Here is the caller graph for this function:

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

Here is the caller graph for this function:

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

Here is the caller graph for this function:

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

Here is the caller graph for this function:

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

Here is the call graph for this function:

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

Here is the call graph for this function:

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

Here is the call graph for this function:

int cob_numeric_cmp ( cob_field f1,
cob_field f2 
)

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

Here is the call graph for this function:

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 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;
        }
}
int cob_sub ( cob_field f1,
cob_field f2,
const int  opt 
)

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

Here is the call graph for this function:

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

Here is the call graph for this function:

 All Classes Files Functions Variables Typedefs Enumerations Enumerator Defines