|
OpenCOBOL 1.1pre-rel
|
|
OpenCOBOL 1.1pre-rel
|
#include "config.h"#include <stdio.h>#include <stdlib.h>#include <stdarg.h>#include <string.h>#include <ctype.h>#include <time.h>#include <sys/time.h>#include <errno.h>#include <math.h>#include <langinfo.h>#include <locale.h>#include "byteswap.h"#include "common.h"#include "coblocal.h"#include "move.h"#include "numeric.h"#include "fileio.h"#include "intrinsic.h"
Go to the source code of this file.
| #define COB_FIELD_INIT | ( | x, | |
| y, | |||
| z | |||
| ) |
do { \ field.size = x; \ field.data = y; \ field.attr = z; \ } while (0)
Definition at line 59 of file intrinsic.c.
| #define DEPTH_LEVEL 8 |
Definition at line 57 of file intrinsic.c.
| static void COB_NOINLINE calc_ref_mod | ( | cob_field * | f, |
| const int | offset, | ||
| const int | length | ||
| ) | [static] |
Definition at line 409 of file intrinsic.c.
{
size_t calcoff;
size_t size;
if ((size_t)offset <= f->size) {
calcoff = (size_t)offset - 1;
size = f->size - calcoff;
if (length > 0 && (size_t)length < size) {
size = (size_t)length;
}
f->size = size;
if (calcoff > 0) {
memmove (f->data, f->data + calcoff, size);
}
}
}
| void cob_init_intrinsic | ( | void | ) |
Definition at line 3269 of file intrinsic.c.
{
size_t i;
cob_decimal_init (&d1);
cob_decimal_init (&d2);
cob_decimal_init (&d3);
cob_decimal_init (&d4);
cob_decimal_init (&d5);
/* mpz_init2 (mp, 256); */
memset ((char *)&calc_field[0], 0, sizeof (calc_field));
memset ((char *)&calc_attr[0], 0, sizeof (calc_attr));
for (i = 0; i < DEPTH_LEVEL; ++i) {
calc_field[i].data = cob_malloc (256);
calc_field[i].size = 256;
calc_size[i] = 256;
}
locale_buff = cob_malloc (COB_SMALL_BUFF);
}
Definition at line 1545 of file intrinsic.c.
{
make_field_entry (srcfield);
cob_decimal_set_field (&d1, srcfield);
mpz_abs (d1.value, d1.value);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 1557 of file intrinsic.c.
{
unsigned long long result;
double mathd2;
int i, tempres;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, 0, NULL);
COB_FIELD_INIT (8, NULL, &attr);
cob_decimal_set_field (&d1, srcfield);
make_field_entry (&field);
errno = 0;
mathd2 = acos (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
result = (unsigned long long) mathd2;
mathd2 -= result;
for (i = 0; i < 17; ++i) {
mathd2 *= 10;
tempres = (int) mathd2;
result *= 10;
result += tempres;
mathd2 -= tempres;
}
memcpy (curr_field->data, (char *)&result, 8);
return curr_field;
}
Definition at line 1974 of file intrinsic.c.
{
double mathd1, mathd2;
make_double_entry ();
cob_decimal_set_field (&d1, srcfield1);
cob_decimal_set_field (&d2, srcfield2);
mathd1 = intr_get_double (&d1);
mathd2 = intr_get_double (&d2);
if (mathd1 == 0) {
mathd1 = 1.0 / mathd2;
memcpy (curr_field->data, (char *)&mathd1, sizeof (double));
return curr_field;
}
mathd1 /= (1.0 - pow (mathd1 + 1.0, 0.0 - mathd2));
memcpy (curr_field->data, (char *)&mathd1, sizeof (double));
return curr_field;
}
Definition at line 1591 of file intrinsic.c.
{
long long result;
double mathd2;
int i, tempres;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
cob_decimal_set_field (&d1, srcfield);
make_field_entry (&field);
errno = 0;
mathd2 = asin (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
result = (long long) mathd2;
mathd2 -= result;
for (i = 0; i < 17; ++i) {
mathd2 *= 10;
tempres = (int) mathd2;
result *= 10;
result += tempres;
mathd2 -= tempres;
}
memcpy (curr_field->data, (char *)&result, 8);
return curr_field;
}
Definition at line 1624 of file intrinsic.c.
{
long long result;
double mathd2;
int i, tempres;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
cob_decimal_set_field (&d1, srcfield);
make_field_entry (&field);
errno = 0;
mathd2 = atan (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
result = (long long) mathd2;
mathd2 -= result;
for (i = 0; i < 17; ++i) {
mathd2 *= 10;
tempres = (int) mathd2;
result *= 10;
result += tempres;
mathd2 -= tempres;
}
memcpy (curr_field->data, (char *)&result, 8);
return curr_field;
}
Definition at line 432 of file intrinsic.c.
{
/* RXW
size_t bitnum;
size_t sign;
size_t attrsign;
cob_field_attr attr;
cob_field field;
*/
cob_decimal_set_field (&d1, f1);
cob_decimal_set_field (&d2, f2);
switch (op) {
case '+':
cob_decimal_add (&d1, &d2);
break;
case '-':
cob_decimal_sub (&d1, &d2);
break;
case '*':
cob_decimal_mul (&d1, &d2);
break;
case '/':
cob_decimal_div (&d1, &d2);
break;
case '^':
cob_decimal_pow (&d1, &d2);
break;
default:
break;
}
/* RXW
if (mpz_sgn (d1.value) < 0) {
attrsign = COB_FLAG_HAVE_SIGN;
sign = 1;
} else {
attrsign = 0;
sign = 0;
}
bitnum = mpz_sizeinbase (d1.value, 2);
if (bitnum < 33 - sign) {
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, attrsign, NULL);
COB_FIELD_INIT (4, NULL, &attr);
attr.scale = d1.scale;
make_field_entry (&field);
} else if (bitnum < 65 - sign) {
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, attrsign, NULL);
COB_FIELD_INIT (8, NULL, &attr);
attr.scale = d1.scale;
make_field_entry (&field);
} else {
*/
make_double_entry ();
/* RXW
}
*/
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 1121 of file intrinsic.c.
{
int i;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (1, NULL, &attr);
make_field_entry (&field);
i = cob_get_int (srcfield);
if (i < 1 || i > 256) {
*curr_field->data = 0;
} else {
*curr_field->data = i - 1;
}
return curr_field;
}
Definition at line 1178 of file intrinsic.c.
{
int srdays;
int srtime;
cob_field_attr attr;
cob_field field;
char buff[16];
COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 12, 5, 0, NULL);
COB_FIELD_INIT (12, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
srdays = cob_get_int (srcdays);
if (srdays < 1 || srdays > 3067671) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
memset (curr_field->data, '0', 12);
return curr_field;
}
srtime = cob_get_int (srctime);
if (srtime < 1 || srtime > 86400) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
memset (curr_field->data, '0', 12);
return curr_field;
}
snprintf (buff, 15, "%7.7d%5.5d", srdays, srtime);
memcpy (curr_field->data, buff, 12);
return curr_field;
}
| cob_field* cob_intr_concatenate | ( | const int | offset, |
| const int | length, | ||
| const int | params, | ||
| ... | |||
| ) |
Definition at line 639 of file intrinsic.c.
{
cob_field **f;
unsigned char *p;
size_t calcsize;
int i;
cob_field_attr attr;
cob_field field;
va_list args;
f = cob_malloc (params * sizeof (cob_field *));
va_start (args, params);
/* Extract args / calculate size */
calcsize = 0;
for (i = 0; i < params; ++i) {
f[i] = va_arg (args, cob_field *);
calcsize += f[i]->size;
}
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (calcsize, NULL, &attr);
make_field_entry (&field);
p = curr_field->data;
for (i = 0; i < params; ++i) {
memcpy (p, f[i]->data, f[i]->size);
p += f[i]->size;
}
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
free (f);
return curr_field;
}
Definition at line 1657 of file intrinsic.c.
{
long long result;
double mathd2;
int i, tempres;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
cob_decimal_set_field (&d1, srcfield);
make_field_entry (&field);
errno = 0;
mathd2 = cos (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
result = (long long) mathd2;
mathd2 -= result;
for (i = 0; i < 17; ++i) {
mathd2 *= 10;
tempres = (int) mathd2;
result *= 10;
result += tempres;
mathd2 -= tempres;
}
memcpy (curr_field->data, (char *)&result, 8);
return curr_field;
}
| cob_field* cob_intr_current_date | ( | const int | offset, |
| const int | length | ||
| ) |
Definition at line 1032 of file intrinsic.c.
{
#if defined(_WIN32) && !defined(__CYGWIN__)
long contz;
struct tm *tmptr;
struct _timeb tmb;
cob_field_attr attr;
cob_field field;
#else
#if !defined(__linux__) && !defined(__CYGWIN__) && !defined(COB_STRFTIME) && defined(HAVE_TIMEZONE)
struct tm *tmptr;
long contz;
#endif
time_t curtime;
cob_field_attr attr;
cob_field field;
#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
struct timeval tmv;
char buff2[8];
#endif
#endif /* _WIN32 */
char buff[24];
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (21, NULL, &attr);
make_field_entry (&field);
memset (buff, 0, sizeof(buff));
#if defined(_WIN32) && !defined(__CYGWIN__)
_ftime (&tmb);
tmptr = localtime (&(tmb.time));
if (tmb.timezone <= 0) {
contz = -tmb.timezone;
snprintf (buff, 23,
"%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d%2.2d+%2.2ld%2.2ld",
tmptr->tm_year + 1900, tmptr->tm_mon + 1, tmptr->tm_mday,
tmptr->tm_hour, tmptr->tm_min, tmptr->tm_sec,
tmb.millitm / 100, contz / 60, contz % 60);
} else {
contz = tmb.timezone;
snprintf (buff, 23,
"%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d%2.2d-%2.2ld%2.2ld",
tmptr->tm_year + 1900, tmptr->tm_mon + 1, tmptr->tm_mday,
tmptr->tm_hour, tmptr->tm_min, tmptr->tm_sec,
tmb.millitm / 100, contz / 60, contz % 60);
}
#else
#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
gettimeofday (&tmv, NULL);
curtime = tmv.tv_sec;
#else
curtime = time (NULL);
#endif
#if defined(__linux__) || defined(__CYGWIN__) || defined(COB_STRFTIME)
strftime (buff, 22, "%Y%m%d%H%M%S00%z", localtime (&curtime));
#elif defined(HAVE_TIMEZONE)
tmptr = localtime (&curtime);
strftime (buff, 17, "%Y%m%d%H%M%S00", tmptr);
/* RXW - Hack for DST - Need something better */
if (tmptr->tm_isdst > 0) {
timezone -= 3600;
}
if (timezone <= 0) {
contz = -timezone;
buff[16] = '+';
} else {
contz = timezone;
buff[16] = '-';
}
sprintf(&buff[17], "%2.2ld%2.2ld", contz / 3600, (contz % 3600) / 60);
#else
strftime (buff, 22, "%Y%m%d%H%M%S0000000", localtime (&curtime));
#endif
#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
snprintf(buff2, 7, "%2.2ld", tmv.tv_usec / 10000);
memcpy (&buff[14], buff2, 2);
#endif
#endif /* _WIN32 */
memcpy (curr_field->data, buff, 21);
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
}
Definition at line 1209 of file intrinsic.c.
{
int i;
int days;
int baseyear = 1601;
int leapyear = 365;
cob_field_attr attr;
cob_field field;
char buff[16];
COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 8, 0, 0, NULL);
COB_FIELD_INIT (8, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
/* Base 1601-01-01 */
days = cob_get_int (srcdays);
if (days < 1 || days > 3067671) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
memset (curr_field->data, '0', 8);
return curr_field;
}
while (days > leapyear) {
days -= leapyear;
++baseyear;
if (leap_year (baseyear)) {
leapyear = 366;
} else {
leapyear = 365;
}
}
for (i = 0; i < 13; ++i) {
if (leap_year (baseyear)) {
if (days <= leap_days[i]) {
days -= leap_days[i-1];
break;
}
} else {
if (days <= normal_days[i]) {
days -= normal_days[i-1];
break;
}
}
}
snprintf (buff, 15, "%4.4d%2.2d%2.2d", baseyear, i, days);
memcpy (curr_field->data, buff, 8);
return curr_field;
}
| cob_field* cob_intr_date_to_yyyymmdd | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2646 of file intrinsic.c.
{
cob_field *f;
struct tm *timeptr;
va_list args;
time_t t;
int year;
int mmdd;
int interval;
int xqtyear;
int maxyear;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
va_start (args, params);
f = va_arg (args, cob_field *);
year = cob_get_int (f);
mmdd = year % 10000;
year /= 10000;
if (params > 1) {
f = va_arg (args, cob_field *);
interval = cob_get_int (f);
} else {
interval = 50;
}
if (params > 2) {
f = va_arg (args, cob_field *);
xqtyear = cob_get_int (f);
} else {
t = time (NULL);
timeptr = localtime (&t);
xqtyear = 1900 + timeptr->tm_year;
}
va_end (args);
if (year < 0 || year > 999999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
if (xqtyear < 1601 || xqtyear > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
maxyear = xqtyear + interval;
if (maxyear < 1700 || maxyear > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
if (maxyear % 100 >= year) {
year += 100 * (maxyear / 100);
} else {
year += 100 * ((maxyear / 100) - 1);
}
year *= 10000;
year += mmdd;
cob_set_int (curr_field, year);
return curr_field;
}
Definition at line 1259 of file intrinsic.c.
{
int days;
int baseyear = 1601;
int leapyear = 365;
cob_field_attr attr;
cob_field field;
char buff[16];
COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 7, 0, 0, NULL);
COB_FIELD_INIT (7, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
/* Base 1601-01-01 */
days = cob_get_int (srcdays);
if (days < 1 || days > 3067671) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
memset (curr_field->data, '0', 7);
return curr_field;
}
while (days > leapyear) {
days -= leapyear;
++baseyear;
if (leap_year (baseyear)) {
leapyear = 366;
} else {
leapyear = 365;
}
}
snprintf (buff, 15, "%4.4d%3.3d", baseyear, days);
memcpy (curr_field->data, buff, 7);
return curr_field;
}
| cob_field* cob_intr_day_to_yyyyddd | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2714 of file intrinsic.c.
{
cob_field *f;
struct tm *timeptr;
va_list args;
time_t t;
int year;
int days;
int interval;
int xqtyear;
int maxyear;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
va_start (args, params);
f = va_arg (args, cob_field *);
year = cob_get_int (f);
days = year % 1000;
year /= 1000;
if (params > 1) {
f = va_arg (args, cob_field *);
interval = cob_get_int (f);
} else {
interval = 50;
}
if (params > 2) {
f = va_arg (args, cob_field *);
xqtyear = cob_get_int (f);
} else {
t = time (NULL);
timeptr = localtime (&t);
xqtyear = 1900 + timeptr->tm_year;
}
va_end (args);
if (year < 0 || year > 999999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
if (xqtyear < 1601 || xqtyear > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
maxyear = xqtyear + interval;
if (maxyear < 1700 || maxyear > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
if (maxyear % 100 >= year) {
year += 100 * (maxyear / 100);
} else {
year += 100 * ((maxyear / 100) - 1);
}
year *= 1000;
year += days;
cob_set_int (curr_field, year);
return curr_field;
}
| cob_field* cob_intr_exception_file | ( | void | ) |
Definition at line 916 of file intrinsic.c.
{
size_t flen;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (0, NULL, &attr);
if (cob_exception_code == 0 || !cob_error_file ||
(cob_exception_code & 0x0500) != 0x0500) {
field.size = 2;
make_field_entry (&field);
memcpy (curr_field->data, "00", 2);
} else {
flen = strlen (cob_error_file->select_name);
field.size = flen + 2;
make_field_entry (&field);
memcpy (curr_field->data, cob_error_file->file_status, 2);
memcpy (&(curr_field->data[2]), cob_error_file->select_name, flen);
}
return curr_field;
}
| cob_field* cob_intr_exception_location | ( | void | ) |
Definition at line 940 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (0, NULL, &attr);
if (!cob_got_exception || !cob_orig_program_id) {
field.size = 1;
make_field_entry (&field);
*(curr_field->data) = ' ';
return curr_field;
}
memset (locale_buff, 0, COB_SMALL_BUFF);
if (cob_orig_section && cob_orig_paragraph) {
snprintf (locale_buff, COB_SMALL_MAX, "%s; %s OF %s; %d",
cob_orig_program_id, cob_orig_paragraph,
cob_orig_section, cob_orig_line);
} else if (cob_orig_section) {
snprintf (locale_buff, COB_SMALL_MAX, "%s; %s; %d",
cob_orig_program_id, cob_orig_section, cob_orig_line);
} else if (cob_orig_paragraph) {
snprintf (locale_buff, COB_SMALL_MAX, "%s; %s; %d",
cob_orig_program_id, cob_orig_paragraph, cob_orig_line);
} else {
snprintf (locale_buff, COB_SMALL_MAX, "%s; ; %d",
cob_orig_program_id, cob_orig_line);
}
field.size = strlen (locale_buff);
make_field_entry (&field);
memcpy (curr_field->data, locale_buff, field.size);
return curr_field;
}
| cob_field* cob_intr_exception_statement | ( | void | ) |
Definition at line 997 of file intrinsic.c.
{
size_t flen;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (31, NULL, &attr);
make_field_entry (&field);
memset (curr_field->data, ' ', 31);
if (cob_exception_code && cob_orig_statement) {
flen = strlen (cob_orig_statement);
if (flen > 31) {
memcpy (curr_field->data, cob_orig_statement, 31);
} else {
memcpy (curr_field->data, cob_orig_statement, flen);
}
}
return curr_field;
}
| cob_field* cob_intr_exception_status | ( | void | ) |
Definition at line 975 of file intrinsic.c.
{
const char *except_name;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (31, NULL, &attr);
make_field_entry (&field);
memset (curr_field->data, ' ', 31);
if (cob_exception_code) {
except_name = cob_get_exception_name (cob_exception_code);
if (except_name == NULL) {
except_name = "EXCEPTION-OBJECT";
}
memcpy (curr_field->data, except_name, strlen (except_name));
}
return curr_field;
}
Definition at line 1509 of file intrinsic.c.
{
double mathd2;
cob_decimal_set_field (&d1, srcfield);
make_double_entry ();
errno = 0;
mathd2 = pow (2.7182818284590452354, intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
memcpy (curr_field->data, (char *)&mathd2, 8);
return curr_field;
}
Definition at line 1527 of file intrinsic.c.
{
double mathd2;
cob_decimal_set_field (&d1, srcfield);
make_double_entry ();
errno = 0;
mathd2 = pow (10.0, intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
memcpy (curr_field->data, (char *)&mathd2, 8);
return curr_field;
}
Definition at line 1485 of file intrinsic.c.
{
int srcval;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, 0, NULL);
COB_FIELD_INIT (8, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
srcval = cob_get_int (srcfield);
if (srcval < 0) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
d1.scale = 0;
mpz_fac_ui (d1.value, (unsigned int)srcval);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 552 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 18, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
make_field_entry (&field);
cob_move (srcfield, curr_field);
return curr_field;
}
Definition at line 511 of file intrinsic.c.
{
int i, scale;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
make_field_entry (&field);
cob_decimal_set_field (&d1, srcfield);
if (mpz_sgn (d1.value) >= 0) {
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
scale = 1;
for (i = 0; i < d1.scale; ++i) {
scale *= 10;
}
if (mpz_fdiv_ui (d1.value, (unsigned int)scale)) {
mpz_sub_ui (d1.value, d1.value, (unsigned int)scale);
}
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 1295 of file intrinsic.c.
{
int indate;
int days;
int totaldays;
int month;
int year;
int baseyear = 1601;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
/* Base 1601-01-01 */
indate = cob_get_int (srcfield);
year = indate / 10000;
if (year < 1601 || year > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
indate %= 10000;
month = indate / 100;
if (month < 1 || month > 12) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
days = indate % 100;
if (days < 1 || days > 31) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
if (leap_year (year)) {
if (days > leap_month_days[month]) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
} else {
if (days > normal_month_days[month]) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
}
totaldays = 0;
while (baseyear != year) {
if (leap_year (baseyear)) {
totaldays += 366;
} else {
totaldays += 365;
}
++baseyear;
}
if (leap_year (baseyear)) {
totaldays += leap_days[month - 1];
} else {
totaldays += normal_days[month - 1];
}
totaldays += days;
cob_set_int (curr_field, totaldays);
return curr_field;
}
Definition at line 1365 of file intrinsic.c.
{
int indate;
int days;
int totaldays;
int year;
int baseyear = 1601;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
/* Base 1601-01-01 */
indate = cob_get_int (srcfield);
year = indate / 1000;
if (year < 1601 || year > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
days = indate % 1000;
if (days < 1 || days > 365 + leap_year (year)) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
totaldays = 0;
while (baseyear != year) {
if (leap_year (baseyear)) {
totaldays += 366;
} else {
totaldays += 365;
}
++baseyear;
}
totaldays += days;
cob_set_int (curr_field, totaldays);
return curr_field;
}
Definition at line 538 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
make_field_entry (&field);
cob_move (srcfield, curr_field);
return curr_field;
}
| cob_field* cob_intr_lcl_time_from_secs | ( | const int | offset, |
| const int | length, | ||
| cob_field * | srcfield, | ||
| cob_field * | locale_field | ||
| ) |
Definition at line 3149 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
size_t len;
int indate;
int hours;
int minutes;
int seconds;
#ifdef HAVE_LANGINFO_CODESET
char *deflocale = NULL;
char *localep = NULL;
char *localep2;
struct tm tstruct;
char buff2[128];
#else
char *p;
LCID localeid = LOCALE_USER_DEFAULT;
SYSTEMTIME syst;
#endif
char buff[128];
#endif
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (0, NULL, &attr);
cob_exception_code = 0;
#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
if (COB_FIELD_IS_NUMERIC (srcfield)) {
indate = cob_get_int (srcfield);
} else {
goto derror;
}
if (indate > 86400) {
goto derror;
}
hours = indate / 3600;
indate %= 3600;
minutes = indate / 60;
seconds = indate % 60;
#ifdef HAVE_LANGINFO_CODESET
memset ((void *)&tstruct, 0, sizeof(struct tm));
tstruct.tm_hour = hours;
tstruct.tm_min = minutes;
tstruct.tm_sec = seconds;
if (locale_field) {
if (locale_field->size >= COB_SMALL_BUFF) {
goto derror;
}
cob_field_to_string (locale_field, locale_buff);
deflocale = locale_buff;
localep2 = setlocale (LC_TIME, NULL);
if (localep2) {
localep = strdup (localep2);
}
(void) setlocale (LC_TIME, deflocale);
}
memset (buff2, 0, sizeof(buff2));
snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(T_FMT));
if (deflocale) {
if (localep) {
(void) setlocale (LC_TIME, localep);
}
}
strftime (buff, sizeof(buff), buff2, &tstruct);
#else
memset ((void *)&syst, 0, sizeof(syst));
syst.wHour = hours;
syst.wMinute = minutes;
syst.wSecond = seconds;
if (locale_field) {
if (locale_field->size >= COB_SMALL_BUFF) {
goto derror;
}
cob_field_to_string (locale_field, locale_buff);
for (p = locale_buff; *p; ++p) {
if (isalnum(*p) || *p == '_') {
continue;
}
break;
}
*p = 0;
for (len = 0; len < WINLOCSIZE; ++len) {
if (!strcmp(locale_buff, wintable[len].winlocalename)) {
localeid = wintable[len].winlocaleid;
break;
}
}
if (len == WINLOCSIZE) {
goto derror;
}
}
if (!GetTimeFormat (localeid, LOCALE_NOUSEROVERRIDE, &syst, NULL, buff, sizeof(buff))) {
goto derror;
}
#endif
len = strlen (buff);
field.size = len;
make_field_entry (&field);
memcpy (curr_field->data, buff, len);
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
derror:
#endif
field.size = 10;
make_field_entry (&field);
memset (curr_field->data, ' ', 10);
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
return curr_field;
}
Definition at line 497 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_set_int (curr_field, (int)srcfield->size);
return curr_field;
}
| cob_field* cob_intr_locale_date | ( | const int | offset, |
| const int | length, | ||
| cob_field * | srcfield, | ||
| cob_field * | locale_field | ||
| ) |
Definition at line 2866 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
size_t len;
int indate;
int days;
int month;
int year;
#ifdef HAVE_LANGINFO_CODESET
unsigned char *p;
char *deflocale = NULL;
char *localep = NULL;
char *localep2;
struct tm tstruct;
char buff2[128];
#else
char *p;
LCID localeid = LOCALE_USER_DEFAULT;
SYSTEMTIME syst;
#endif
char buff[128];
#endif
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (0, NULL, &attr);
cob_exception_code = 0;
#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
if (COB_FIELD_IS_NUMERIC (srcfield)) {
indate = cob_get_int (srcfield);
} else {
if (srcfield->size < 8) {
goto derror;
}
p = srcfield->data;
indate = 0;
for (len = 0; len < 8; ++len, ++p) {
if (isdigit (*p)) {
indate *= 10;
indate += (*p - '0');
} else {
goto derror;
}
}
}
year = indate / 10000;
if (year < 1601 || year > 9999) {
goto derror;
}
indate %= 10000;
month = indate / 100;
if (month < 1 || month > 12) {
goto derror;
}
days = indate % 100;
if (days < 1 || days > 31) {
goto derror;
}
if (leap_year (year)) {
if (days > leap_month_days[month]) {
goto derror;
}
} else {
if (days > normal_month_days[month]) {
goto derror;
}
}
#ifdef HAVE_LANGINFO_CODESET
month--;
memset ((void *)&tstruct, 0, sizeof(struct tm));
tstruct.tm_year = year - 1900;
tstruct.tm_mon = month;
tstruct.tm_mday = days;
if (locale_field) {
if (locale_field->size >= COB_SMALL_BUFF) {
goto derror;
}
cob_field_to_string (locale_field, locale_buff);
deflocale = locale_buff;
localep2 = setlocale (LC_TIME, NULL);
if (localep2) {
localep = strdup (localep2);
}
(void) setlocale (LC_TIME, deflocale);
}
memset (buff2, 0, sizeof(buff2));
snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(D_FMT));
if (deflocale) {
if (localep) {
(void) setlocale (LC_TIME, localep);
}
}
strftime (buff, sizeof(buff), buff2, &tstruct);
#else
memset ((void *)&syst, 0, sizeof(syst));
syst.wYear = year;
syst.wMonth = month;
syst.wDay = days;
if (locale_field) {
if (locale_field->size >= COB_SMALL_BUFF) {
goto derror;
}
cob_field_to_string (locale_field, locale_buff);
for (p = locale_buff; *p; ++p) {
if (isalnum(*p) || *p == '_') {
continue;
}
break;
}
*p = 0;
for (len = 0; len < WINLOCSIZE; ++len) {
if (!strcmp(locale_buff, wintable[len].winlocalename)) {
localeid = wintable[len].winlocaleid;
break;
}
}
if (len == WINLOCSIZE) {
goto derror;
}
}
if (!GetDateFormat (localeid, DATE_SHORTDATE, &syst, NULL, buff, sizeof(buff))) {
goto derror;
}
#endif
len = strlen (buff);
field.size = len;
make_field_entry (&field);
memcpy (curr_field->data, buff, len);
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
derror:
#endif
field.size = 10;
make_field_entry (&field);
memset (curr_field->data, ' ', 10);
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
return curr_field;
}
| cob_field* cob_intr_locale_time | ( | const int | offset, |
| const int | length, | ||
| cob_field * | srcfield, | ||
| cob_field * | locale_field | ||
| ) |
Definition at line 3012 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
size_t len;
int indate;
int hours;
int minutes;
int seconds;
#ifdef HAVE_LANGINFO_CODESET
unsigned char *p;
char *deflocale = NULL;
char *localep = NULL;
char *localep2;
struct tm tstruct;
char buff2[128];
#else
char *p;
LCID localeid = LOCALE_USER_DEFAULT;
SYSTEMTIME syst;
#endif
char buff[128];
#endif
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (0, NULL, &attr);
cob_exception_code = 0;
#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
if (COB_FIELD_IS_NUMERIC (srcfield)) {
indate = cob_get_int (srcfield);
} else {
if (srcfield->size < 6) {
goto derror;
}
p = srcfield->data;
indate = 0;
for (len = 0; len < 6; ++len, ++p) {
if (isdigit (*p)) {
indate *= 10;
indate += (*p - '0');
} else {
goto derror;
}
}
}
hours = indate / 10000;
if (hours < 0 || hours > 24) {
goto derror;
}
indate %= 10000;
minutes = indate / 100;
if (minutes < 0 || minutes > 59) {
goto derror;
}
seconds = indate % 100;
if (seconds < 0 || seconds > 59) {
goto derror;
}
#ifdef HAVE_LANGINFO_CODESET
memset ((void *)&tstruct, 0, sizeof(struct tm));
tstruct.tm_hour = hours;
tstruct.tm_min = minutes;
tstruct.tm_sec = seconds;
if (locale_field) {
if (locale_field->size >= COB_SMALL_BUFF) {
goto derror;
}
cob_field_to_string (locale_field, locale_buff);
deflocale = locale_buff;
localep2 = setlocale (LC_TIME, NULL);
if (localep2) {
localep = strdup (localep2);
}
(void) setlocale (LC_TIME, deflocale);
}
memset (buff2, 0, sizeof(buff2));
snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(T_FMT));
if (deflocale) {
if (localep) {
(void) setlocale (LC_TIME, localep);
}
}
strftime (buff, sizeof(buff), buff2, &tstruct);
#else
memset ((void *)&syst, 0, sizeof(syst));
syst.wHour = hours;
syst.wMinute = minutes;
syst.wSecond = seconds;
if (locale_field) {
if (locale_field->size >= COB_SMALL_BUFF) {
goto derror;
}
cob_field_to_string (locale_field, locale_buff);
for (p = locale_buff; *p; ++p) {
if (isalnum(*p) || *p == '_') {
continue;
}
break;
}
*p = 0;
for (len = 0; len < WINLOCSIZE; ++len) {
if (!strcmp(locale_buff, wintable[len].winlocalename)) {
localeid = wintable[len].winlocaleid;
break;
}
}
if (len == WINLOCSIZE) {
goto derror;
}
}
if (!GetTimeFormat (localeid, LOCALE_NOUSEROVERRIDE, &syst, NULL, buff, sizeof(buff))) {
goto derror;
}
#endif
len = strlen (buff);
field.size = len;
make_field_entry (&field);
memcpy (curr_field->data, buff, len);
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
derror:
#endif
field.size = 10;
make_field_entry (&field);
memset (curr_field->data, ' ', 10);
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
return curr_field;
}
Definition at line 1690 of file intrinsic.c.
{
double mathd2;
cob_decimal_set_field (&d1, srcfield);
make_double_entry ();
errno = 0;
mathd2 = log (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
memcpy (curr_field->data, (char *)&mathd2, 8);
return curr_field;
}
Definition at line 1708 of file intrinsic.c.
{
double mathd2;
cob_decimal_set_field (&d1, srcfield);
make_double_entry ();
errno = 0;
mathd2 = log10 (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
memcpy (curr_field->data, (char *)&mathd2, 8);
return curr_field;
}
Definition at line 605 of file intrinsic.c.
{
size_t i, size;
make_field_entry (srcfield);
size = srcfield->size;
for (i = 0; i < size; ++i) {
curr_field->data[i] = tolower (srcfield->data[i]);
}
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
}
| cob_field* cob_intr_max | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2125 of file intrinsic.c.
{
cob_field *f, *basef;
va_list args;
int i;
va_start (args, params);
basef = va_arg (args, cob_field *);
for (i = 1; i < params; ++i) {
f = va_arg (args, cob_field *);
if (cob_cmp (f, basef) > 0) {
basef = f;
}
}
va_end (args);
return basef;
}
| cob_field* cob_intr_mean | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2224 of file intrinsic.c.
{
cob_field *f;
va_list args;
long long n;
union {
unsigned char data[8];
long long datall;
} datun;
int i;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
mpz_set_ui (d1.value, 0);
d1.scale = 0;
va_start (args, params);
for (i = 0; i < params; ++i) {
f = va_arg (args, cob_field *);
cob_decimal_set_field (&d2, f);
cob_decimal_add (&d1, &d2);
}
va_end (args);
mpz_set_ui (d2.value, (unsigned int)params);
d2.scale = 0;
cob_decimal_div (&d1, &d2);
field.data = datun.data;
cob_decimal_get_field (&d1, &field, 0);
n = datun.datall;
for (i = 0; n; n /= 10, ++i) ;
field.data = NULL;
if (i <= 18) {
attr.scale = 18 - i;
}
make_field_entry (&field);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
| cob_field* cob_intr_median | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2179 of file intrinsic.c.
{
cob_field *f;
cob_field **field_alloc;
va_list args;
int i;
va_start (args, params);
f = va_arg (args, cob_field *);
if (params == 1) {
va_end (args);
return f;
}
field_alloc = cob_malloc (params * sizeof (cob_field *));
field_alloc[0] = f;
for (i = 1; i < params; ++i) {
field_alloc[i] = va_arg (args, cob_field *);
}
va_end (args);
qsort (field_alloc, (size_t)params, (size_t)sizeof (cob_field *), comp_field);
i = params / 2;
if (params % 2) {
f = field_alloc[i];
} else {
make_double_entry ();
cob_decimal_set_field (&d1, field_alloc[i-1]);
cob_decimal_set_field (&d2, field_alloc[i]);
cob_decimal_add (&d1, &d2);
mpz_set_ui (d2.value, 2);
d2.scale = 0;
cob_decimal_div (&d1, &d2);
cob_decimal_get_field (&d1, curr_field, 0);
f = curr_field;
}
free (field_alloc);
return f;
}
| cob_field* cob_intr_midrange | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2146 of file intrinsic.c.
{
cob_field *f, *basemin, *basemax;
va_list args;
int i;
make_double_entry ();
va_start (args, params);
basemin = va_arg (args, cob_field *);
basemax = basemin;
for (i = 1; i < params; ++i) {
f = va_arg (args, cob_field *);
if (cob_cmp (f, basemin) < 0) {
basemin = f;
}
if (cob_cmp (f, basemax) > 0) {
basemax = f;
}
}
va_end (args);
cob_decimal_set_field (&d1, basemin);
cob_decimal_set_field (&d2, basemax);
cob_decimal_add (&d1, &d2);
mpz_set_ui (d2.value, 2);
d2.scale = 0;
cob_decimal_div (&d1, &d2);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
| cob_field* cob_intr_min | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2104 of file intrinsic.c.
{
cob_field *f, *basef;
va_list args;
int i;
va_start (args, params);
basef = va_arg (args, cob_field *);
for (i = 1; i < params; ++i) {
f = va_arg (args, cob_field *);
if (cob_cmp (f, basef) < 0) {
basef = f;
}
}
va_end (args);
return basef;
}
Definition at line 2268 of file intrinsic.c.
{
cob_field *f1;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
make_field_entry (&field);
f1 = cob_intr_integer (cob_intr_binop (srcfield1, '/', srcfield2));
cob_decimal_set_field (&d1, srcfield2);
cob_decimal_set_field (&d2, f1);
cob_decimal_mul (&d2, &d1);
cob_decimal_set_field (&d1, srcfield1);
cob_decimal_sub (&d1, &d2);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 1795 of file intrinsic.c.
{
long long llval = 0;
double val;
size_t i;
int integer_digits = 0;
int decimal_digits = 0;
int sign = 0;
int decimal_seen = 0;
cob_field_attr attr;
cob_field field;
unsigned char integer_buff[64];
unsigned char decimal_buff[64];
unsigned char final_buff[64];
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
memset (integer_buff, 0, sizeof (integer_buff));
memset (decimal_buff, 0, sizeof (decimal_buff));
memset (final_buff, 0, sizeof (final_buff));
for (i = 0; i < srcfield->size; ++i) {
if (i < (srcfield->size - 2)) {
if (strcasecmp ((char *)&srcfield->data[i], "CR") == 0
|| strcasecmp ((char *)&srcfield->data[i], "DB") == 0) {
sign = 1;
break;
}
}
if (srcfield->data[i] == ' ') {
continue;
}
if (srcfield->data[i] == '+') {
continue;
}
if (srcfield->data[i] == '-') {
sign = 1;
continue;
}
if (srcfield->data[i] == cob_current_module->decimal_point) {
decimal_seen = 1;
continue;
}
if (srcfield->data[i] >= '0' && srcfield->data[i] <= '9') {
llval *= 10;
llval += srcfield->data[i] - '0';
if (decimal_seen) {
decimal_buff[decimal_digits++] = srcfield->data[i];
} else {
integer_buff[integer_digits++] = srcfield->data[i];
}
}
if ((integer_digits + decimal_digits) > 30) {
break;
}
}
if (!integer_digits) {
integer_buff[0] = '0';
}
if (!decimal_digits) {
decimal_buff[0] = '0';
}
if (sign) {
llval = -llval;
}
if ((integer_digits + decimal_digits) <= 18) {
attr.scale = decimal_digits;
make_field_entry (&field);
memcpy (curr_field->data, (char *)&llval, 8);
} else {
snprintf ((char *)final_buff, 63, "%s%s.%s", sign ? "-" : "",
integer_buff, decimal_buff);
sscanf ((char *)final_buff, "%lf", &val);
make_double_entry ();
memcpy (curr_field->data, (char *)&val, sizeof (double));
}
return curr_field;
}
Definition at line 1875 of file intrinsic.c.
{
unsigned char *currency_data;
long long llval = 0;
double val;
size_t i;
int integer_digits = 0;
int decimal_digits = 0;
int sign = 0;
int decimal_seen = 0;
cob_field_attr attr;
cob_field field;
unsigned char integer_buff[64];
unsigned char decimal_buff[64];
unsigned char final_buff[64];
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
memset (integer_buff, 0, sizeof (integer_buff));
memset (decimal_buff, 0, sizeof (decimal_buff));
memset (final_buff, 0, sizeof (final_buff));
currency_data = NULL;
if (currency) {
if (currency->size < srcfield->size) {
currency_data = currency->data;
}
}
for (i = 0; i < srcfield->size; ++i) {
if (i < (srcfield->size - 2)) {
if (strcasecmp ((char *)&srcfield->data[i], "CR") == 0
|| strcasecmp ((char *)&srcfield->data[i], "DB") == 0) {
sign = 1;
break;
}
}
if (currency_data) {
if (i < (srcfield->size - currency->size)) {
if (memcmp ((char *)&srcfield->data[i], currency_data,
currency->size) == 0) {
i += (currency->size - 1);
continue;
}
}
}
if (srcfield->data[i] == ' ') {
continue;
}
if (srcfield->data[i] == '+') {
continue;
}
if (srcfield->data[i] == '-') {
sign = 1;
continue;
}
if (srcfield->data[i] == cob_current_module->decimal_point) {
decimal_seen = 1;
continue;
}
if (srcfield->data[i] == cob_current_module->currency_symbol) {
continue;
}
if (srcfield->data[i] >= '0' && srcfield->data[i] <= '9') {
llval *= 10;
llval += srcfield->data[i] - '0';
if (decimal_seen) {
decimal_buff[decimal_digits++] = srcfield->data[i];
} else {
integer_buff[integer_digits++] = srcfield->data[i];
}
}
if ((integer_digits + decimal_digits) > 30) {
break;
}
}
if (!integer_digits) {
integer_buff[0] = '0';
}
if (!decimal_digits) {
decimal_buff[0] = '0';
}
if (sign) {
llval = -llval;
}
if ((integer_digits + decimal_digits) <= 18) {
attr.scale = decimal_digits;
make_field_entry (&field);
memcpy (curr_field->data, (char *)&llval, 8);
} else {
snprintf ((char *)final_buff, 63, "%s%s.%s", sign ? "-" : "",
integer_buff, decimal_buff);
sscanf ((char *)final_buff, "%lf", &val);
make_double_entry ();
memcpy (curr_field->data, (char *)&val, sizeof (double));
}
return curr_field;
}
Definition at line 1141 of file intrinsic.c.
{
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_set_int (curr_field, (int)(*srcfield->data + 1));
return curr_field;
}
| cob_field* cob_intr_ord_max | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2069 of file intrinsic.c.
{
cob_field *f, *basef;
int ordmin = 0;
int i;
va_list args;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
if (params <= 1) {
cob_set_int (curr_field, 0);
return curr_field;
}
va_start (args, params);
basef = va_arg (args, cob_field *);
for (i = 1; i < params; ++i) {
f = va_arg (args, cob_field *);
if (cob_cmp (f, basef) > 0) {
basef = f;
ordmin = i;
}
}
va_end (args);
cob_set_int (curr_field, ordmin + 1);
return curr_field;
}
| cob_field* cob_intr_ord_min | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2034 of file intrinsic.c.
{
cob_field *f, *basef;
int i;
int ordmin = 0;
va_list args;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
if (params <= 1) {
cob_set_int (curr_field, 0);
return curr_field;
}
va_start (args, params);
basef = va_arg (args, cob_field *);
for (i = 1; i < params; ++i) {
f = va_arg (args, cob_field *);
if (cob_cmp (f, basef) < 0) {
basef = f;
ordmin = i;
}
}
va_end (args);
cob_set_int (curr_field, ordmin + 1);
return curr_field;
}
| cob_field* cob_intr_present_value | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2538 of file intrinsic.c.
{
cob_field *f;
va_list args;
int i;
va_start (args, params);
make_double_entry ();
if (params < 2) {
va_end (args);
fprintf (stderr, "Wrong number of parameters for FUNCTION PRESENT-VALUE\n");
fflush (stderr);
cob_set_int (curr_field, 0);
return curr_field;
}
f = va_arg (args, cob_field *);
cob_decimal_set_field (&d1, f);
mpz_set_ui (d2.value, 1);
d2.scale = 0;
cob_decimal_add (&d1, &d2);
mpz_set_ui (d4.value, 0);
d4.scale = 0;
for (i = 1; i < params; ++i) {
f = va_arg (args, cob_field *);
cob_decimal_set_field (&d2, f);
mpz_set (d3.value, d1.value);
d3.scale = d1.scale;
if (i > 1) {
mpz_set_ui (d5.value, (unsigned int)i);
d5.scale = 0;
cob_decimal_pow (&d3, &d5);
}
cob_decimal_div (&d2, &d3);
cob_decimal_add (&d4, &d2);
}
va_end (args);
cob_decimal_get_field (&d4, curr_field, 0);
return curr_field;
}
| cob_field* cob_intr_random | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2352 of file intrinsic.c.
{
cob_field *f;
va_list args;
int seed = 1;
int randnum;
int i;
int exp10;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 9, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
va_start (args, params);
if (params) {
f = va_arg (args, cob_field *);
seed = cob_get_int (f);
if (seed < 0) {
seed = 0;
}
#ifdef __CYGWIN__
srandom ((unsigned int)seed);
#else
srand ((unsigned int)seed);
#endif
}
va_end (args);
#ifdef __CYGWIN__
randnum = (int)random ();
#else
randnum = rand ();
#endif
exp10 = 1;
for (i = 0; i < 10; ++i) {
if ((randnum / exp10) == 0) {
break;
}
exp10 *= 10;
}
if (i == 0) {
i = 1;
}
attr.scale = i;
make_field_entry (&field);
*(long long *)curr_field->data = (long long)randnum;
return curr_field;
}
| cob_field* cob_intr_range | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2289 of file intrinsic.c.
{
cob_field *f, *basemin, *basemax;
va_list args;
int i;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
va_start (args, params);
basemin = va_arg (args, cob_field *);
basemax = basemin;
for (i = 1; i < params; ++i) {
f = va_arg (args, cob_field *);
if (cob_cmp (f, basemin) < 0) {
basemin = f;
}
if (cob_cmp (f, basemax) > 0) {
basemax = f;
}
}
va_end (args);
attr.scale = COB_FIELD_SCALE(basemin);
if (COB_FIELD_SCALE(basemax) > attr.scale) {
attr.scale = COB_FIELD_SCALE(basemax);
}
make_field_entry (&field);
cob_decimal_set_field (&d1, basemax);
cob_decimal_set_field (&d2, basemin);
cob_decimal_sub (&d1, &d2);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 2327 of file intrinsic.c.
{
cob_field *f1;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
f1 = cob_intr_integer_part (cob_intr_binop (srcfield1, '/', srcfield2));
cob_decimal_set_field (&d1, srcfield2);
cob_decimal_set_field (&d2, f1);
cob_decimal_mul (&d2, &d1);
cob_decimal_set_field (&d1, srcfield1);
cob_decimal_sub (&d1, &d2);
attr.scale = COB_FIELD_SCALE(srcfield1);
if (COB_FIELD_SCALE(srcfield2) > attr.scale) {
attr.scale = COB_FIELD_SCALE(srcfield2);
}
make_field_entry (&field);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 622 of file intrinsic.c.
{
size_t i, size;
make_field_entry (srcfield);
size = srcfield->size;
for (i = 0; i < size; ++i) {
curr_field->data[i] = srcfield->data[srcfield->size - i - 1];
}
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
}
Definition at line 2803 of file intrinsic.c.
{
unsigned char *p1;
unsigned char *p2;
size_t n;
int seconds = 0;
int minutes = 0;
int hours = 0;
int seconds_seen = 0;
int minutes_seen = 0;
int hours_seen = 0;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
if (value->size < format->size) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
p1 = format->data;
p2 = value->data;
for (n = 0; n < format->size - 1; ++n, ++p1, ++p2) {
if (!memcmp (p1, "hh", 2) && !hours_seen) {
if (*p2 >= '0' && *p2 <= '9' &&
*(p2 + 1) >= '0' && *(p2 + 1) <= '9') {
hours = ((*p2 - '0') * 10) + (*(p2 + 1) - '0');
hours_seen = 1;
continue;
}
}
if (!memcmp (p1, "mm", 2) && !minutes_seen) {
if (*p2 >= '0' && *p2 <= '9' &&
*(p2 + 1) >= '0' && *(p2 + 1) <= '9') {
minutes = ((*p2 - '0') * 10) + (*(p2 + 1) - '0');
minutes_seen = 1;
continue;
}
}
if (!memcmp (p1, "ss", 2) && !seconds_seen) {
if (*p2 >= '0' && *p2 <= '9' &&
*(p2 + 1) >= '0' && *(p2 + 1) <= '9') {
seconds = ((*p2 - '0') * 10) + (*(p2 + 1) - '0');
seconds_seen = 1;
continue;
}
}
}
if (hours_seen && minutes_seen && seconds_seen) {
seconds += (hours * 3600) + (minutes * 60);
} else {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
seconds = 0;
}
cob_set_int (curr_field, seconds);
return curr_field;
}
| cob_field* cob_intr_seconds_past_midnight | ( | void | ) |
Definition at line 2782 of file intrinsic.c.
{
struct tm *timeptr;
time_t t;
int seconds;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
t = time (NULL);
timeptr = localtime (&t);
seconds = (timeptr->tm_hour * 3600) + (timeptr->tm_min * 60) +
timeptr->tm_sec;
cob_set_int (curr_field, seconds);
return curr_field;
}
Definition at line 566 of file intrinsic.c.
{
int n;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_set_int (curr_field, 0);
n = cob_cmp (srcfield, curr_field);
if (n < 0) {
cob_set_int (curr_field, -1);
} else if (n > 0) {
cob_set_int (curr_field, 1);
}
return curr_field;
}
Definition at line 1726 of file intrinsic.c.
{
long long result;
double mathd2;
int i, tempres;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
cob_decimal_set_field (&d1, srcfield);
make_field_entry (&field);
errno = 0;
mathd2 = sin (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
result = (long long) mathd2;
mathd2 -= result;
for (i = 0; i < 17; ++i) {
mathd2 *= 10;
tempres = (int) mathd2;
result *= 10;
result += tempres;
mathd2 -= tempres;
}
memcpy (curr_field->data, (char *)&result, 8);
return curr_field;
}
Definition at line 1759 of file intrinsic.c.
{
double mathd2;
cob_decimal_set_field (&d1, srcfield);
make_double_entry ();
errno = 0;
mathd2 = sqrt (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
memcpy (curr_field->data, (char *)&mathd2, 8);
return curr_field;
}
| cob_field* cob_intr_standard_deviation | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2472 of file intrinsic.c.
{
cob_field *f;
va_list args;
int i;
va_start (args, params);
make_double_entry ();
if (params == 1) {
va_end (args);
cob_set_int (curr_field, 0);
return curr_field;
}
/* MEAN for all params */
mpz_set_ui (d1.value, 0);
d1.scale = 0;
for (i = 0; i < params; ++i) {
f = va_arg (args, cob_field *);
cob_decimal_set_field (&d2, f);
cob_decimal_add (&d1, &d2);
}
va_end (args);
mpz_set_ui (d2.value, (unsigned int)params);
d2.scale = 0;
cob_decimal_div (&d1, &d2);
/* Got the MEAN in d1, iterate again */
mpz_set_ui (d4.value, 0);
d4.scale = 0;
va_start (args, params);
for (i = 0; i < params; ++i) {
f = va_arg (args, cob_field *);
cob_decimal_set_field (&d2, f);
cob_decimal_sub (&d2, &d1);
cob_decimal_mul (&d2, &d2);
cob_decimal_add (&d4, &d2);
}
va_end (args);
mpz_set_ui (d3.value, (unsigned int)params);
d3.scale = 0;
cob_decimal_div (&d4, &d3);
/* We have the VARIANCE in d4, sqrt = STANDARD-DEVIATION */
/* Do not know why this does not work
d5.scale = d4.scale;
mpz_mul_ui (d5.value, d4.value, 1000000000);
mpz_mul_ui (d4.value, d5.value, 1000000000);
mpz_sqrt (d5.value, d4.value);
mpz_div_ui (d4.value, d5.value, 1000000000);
cob_decimal_get_field (&d4, curr_field, 0);
return curr_field;
*/
cob_decimal_get_field (&d4, curr_field, 0);
f = cob_intr_sqrt (curr_field);
return f;
}
Definition at line 1155 of file intrinsic.c.
{
unsigned char *p;
int count;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
count = srcfield->size;
p = srcfield->data + srcfield->size - 1;
for (; count > 0; count--, p--) {
if (*p != ' ') {
break;
}
}
cob_set_int (curr_field, count);
return curr_field;
}
| cob_field* cob_intr_substitute | ( | const int | offset, |
| const int | length, | ||
| const int | params, | ||
| ... | |||
| ) |
Definition at line 678 of file intrinsic.c.
{
cob_field *var;
cob_field **f1;
cob_field **f2;
unsigned char *p1;
unsigned char *p2;
size_t varsize;
size_t calcsize;
size_t n;
size_t found;
int numreps;
int i;
cob_field_attr attr;
cob_field field;
va_list args;
numreps = params / 2;
f1 = cob_malloc (numreps * sizeof (cob_field *));
f2 = cob_malloc (numreps * sizeof (cob_field *));
va_start (args, params);
var = va_arg (args, cob_field *);
varsize = var->size;
/* Extract args */
for (i = 0; i < params - 1; ++i) {
if ((i % 2) == 0) {
f1[i / 2] = va_arg (args, cob_field *);
} else {
f2[i / 2] = va_arg (args, cob_field *);
}
}
/* Calculate required size */
calcsize = 0;
found = 0;
p1 = var->data;
for (n = 0; n < varsize; ) {
for (i = 0; i < numreps; ++i) {
if (n + f1[i]->size <= varsize) {
if (!memcmp (p1, f1[i]->data, f1[i]->size)) {
p1 += f1[i]->size;
n += f1[i]->size;
calcsize += f2[i]->size;
found = 1;
break;
}
}
}
if (found) {
found = 0;
continue;
}
++n;
++p1;
++calcsize;
}
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (0, NULL, &attr);
field.size = calcsize;
make_field_entry (&field);
found = 0;
p1 = var->data;
p2 = curr_field->data;
for (n = 0; n < varsize; ) {
for (i = 0; i < numreps; ++i) {
if (n + f1[i]->size <= varsize) {
if (!memcmp (p1, f1[i]->data, f1[i]->size)) {
memcpy (p2, f2[i]->data, f2[i]->size);
p1 += f1[i]->size;
p2 += f2[i]->size;
n += f1[i]->size;
found = 1;
break;
}
}
}
if (found) {
found = 0;
continue;
}
++n;
*p2++ = *p1++;
}
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
free (f1);
free (f2);
return curr_field;
}
| cob_field* cob_intr_substitute_case | ( | const int | offset, |
| const int | length, | ||
| const int | params, | ||
| ... | |||
| ) |
Definition at line 775 of file intrinsic.c.
{
cob_field *var;
cob_field **f1;
cob_field **f2;
unsigned char *p1;
unsigned char *p2;
size_t varsize;
size_t calcsize;
size_t n;
size_t found;
int numreps;
int i;
cob_field_attr attr;
cob_field field;
va_list args;
numreps = params / 2;
f1 = cob_malloc (numreps * sizeof (cob_field *));
f2 = cob_malloc (numreps * sizeof (cob_field *));
va_start (args, params);
var = va_arg (args, cob_field *);
varsize = var->size;
/* Extract args */
for (i = 0; i < params - 1; ++i) {
if ((i % 2) == 0) {
f1[i / 2] = va_arg (args, cob_field *);
} else {
f2[i / 2] = va_arg (args, cob_field *);
}
}
/* Calculate required size */
calcsize = 0;
found = 0;
p1 = var->data;
for (n = 0; n < varsize; ) {
for (i = 0; i < numreps; ++i) {
if (n + f1[i]->size <= varsize) {
if (!strncasecmp ((const char *)p1,
(const char *)(f1[i]->data),
f1[i]->size)) {
p1 += f1[i]->size;
n += f1[i]->size;
calcsize += f2[i]->size;
found = 1;
break;
}
}
}
if (found) {
found = 0;
continue;
}
++n;
++p1;
++calcsize;
}
COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL);
COB_FIELD_INIT (0, NULL, &attr);
field.size = calcsize;
make_field_entry (&field);
found = 0;
p1 = var->data;
p2 = curr_field->data;
for (n = 0; n < varsize; ) {
for (i = 0; i < numreps; ++i) {
if (n + f1[i]->size <= varsize) {
if (!strncasecmp ((const char *)p1,
(const char *)(f1[i]->data),
f1[i]->size)) {
memcpy (p2, f2[i]->data, f2[i]->size);
p1 += f1[i]->size;
p2 += f2[i]->size;
n += f1[i]->size;
found = 1;
break;
}
}
}
if (found) {
found = 0;
continue;
}
++n;
*p2++ = *p1++;
}
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
free (f1);
free (f2);
return curr_field;
}
| cob_field* cob_intr_sum | ( | const int | params, |
| ... | |||
| ) |
Definition at line 1996 of file intrinsic.c.
{
cob_field *f;
va_list args;
int i;
int digits = 0;
int scale = 0;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
mpz_set_ui (d1.value, 0);
d1.scale = 0;
va_start (args, params);
for (i = 0; i < params; ++i) {
f = va_arg (args, cob_field *);
if ((COB_FIELD_DIGITS(f) - COB_FIELD_SCALE(f)) > digits) {
digits = COB_FIELD_DIGITS(f) - COB_FIELD_SCALE(f);
}
if (COB_FIELD_SCALE(f) > scale) {
scale = COB_FIELD_SCALE(f);
}
cob_decimal_set_field (&d2, f);
cob_decimal_add (&d1, &d2);
}
va_end (args);
attr.scale = scale;
make_field_entry (&field);
cob_decimal_get_field (&d1, curr_field, 0);
return curr_field;
}
Definition at line 1777 of file intrinsic.c.
{
double mathd2;
cob_decimal_set_field (&d1, srcfield);
make_double_entry ();
errno = 0;
mathd2 = tan (intr_get_double (&d1));
if (errno) {
cob_set_int (curr_field, 0);
return curr_field;
}
memcpy (curr_field->data, (char *)&mathd2, 8);
return curr_field;
}
Definition at line 1409 of file intrinsic.c.
{
int indate;
int days;
int month;
int year;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
/* Base 1601-01-01 */
indate = cob_get_int (srcfield);
year = indate / 10000;
if (year < 1601 || year > 9999) {
cob_set_int (curr_field, 1);
return curr_field;
}
indate %= 10000;
month = indate / 100;
if (month < 1 || month > 12) {
cob_set_int (curr_field, 2);
return curr_field;
}
days = indate % 100;
if (days < 1 || days > 31) {
cob_set_int (curr_field, 3);
return curr_field;
}
if (leap_year (year)) {
if (days > leap_month_days[month]) {
cob_set_int (curr_field, 3);
return curr_field;
}
} else {
if (days > normal_month_days[month]) {
cob_set_int (curr_field, 3);
return curr_field;
}
}
cob_set_int (curr_field, 0);
return curr_field;
}
Definition at line 1456 of file intrinsic.c.
{
int indate;
int days;
int year;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
/* Base 1601-01-01 */
indate = cob_get_int (srcfield);
year = indate / 1000;
if (year < 1601 || year > 9999) {
cob_set_int (curr_field, 1);
return curr_field;
}
days = indate % 1000;
if (days < 1 || days > 365 + leap_year (year)) {
cob_set_int (curr_field, 2);
return curr_field;
}
cob_set_int (curr_field, 0);
return curr_field;
}
| cob_field* cob_intr_trim | ( | const int | offset, |
| const int | length, | ||
| cob_field * | srcfield, | ||
| const int | direction | ||
| ) |
Definition at line 876 of file intrinsic.c.
{
unsigned char *begin;
unsigned char *end;
size_t i;
size_t size = 0;
make_field_entry (srcfield);
for (i = 0; i < srcfield->size; ++i) {
if (srcfield->data[i] != ' ') {
break;
}
}
if (i == srcfield->size) {
curr_field->size = 1;
curr_field->data[0] = ' ';
return curr_field;
}
begin = srcfield->data;
if (direction != 2) {
for (; *begin == ' '; ++begin) ;
}
end = srcfield->data + srcfield->size - 1;
if (direction != 1) {
for (; *end == ' '; end--) ;
}
for (i = 0; begin <= end; ++begin, ++i) {
curr_field->data[i] = *begin;
++size;
}
curr_field->size = size;
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
}
Definition at line 588 of file intrinsic.c.
{
size_t i, size;
make_field_entry (srcfield);
size = srcfield->size;
for (i = 0; i < size; ++i) {
curr_field->data[i] = toupper (srcfield->data[i]);
}
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
}
| cob_field* cob_intr_variance | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2403 of file intrinsic.c.
{
cob_field *f;
va_list args;
long long n;
union {
unsigned char data[8];
long long datall;
} datun;
int i;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL);
COB_FIELD_INIT (8, NULL, &attr);
if (params == 1) {
make_field_entry (&field);
cob_set_int (curr_field, 0);
return curr_field;
}
/* MEAN for all params */
mpz_set_ui (d1.value, 0);
d1.scale = 0;
va_start (args, params);
for (i = 0; i < params; ++i) {
f = va_arg (args, cob_field *);
cob_decimal_set_field (&d2, f);
cob_decimal_add (&d1, &d2);
}
va_end (args);
mpz_set_ui (d2.value, (unsigned int)params);
d2.scale = 0;
cob_decimal_div (&d1, &d2);
/* Got the MEAN in d1, iterate again */
mpz_set_ui (d4.value, 0);
d4.scale = 0;
va_start (args, params);
for (i = 0; i < params; ++i) {
f = va_arg (args, cob_field *);
cob_decimal_set_field (&d2, f);
cob_decimal_sub (&d2, &d1);
cob_decimal_mul (&d2, &d2);
cob_decimal_add (&d4, &d2);
}
va_end (args);
mpz_set_ui (d3.value, (unsigned int)params);
d3.scale = 0;
cob_decimal_div (&d4, &d3);
field.data = datun.data;
cob_decimal_get_field (&d4, &field, 0);
n = datun.datall;
for (i = 0; n; n /= 10, ++i) ;
field.data = NULL;
if (i <= 18) {
attr.scale = 18 - i;
}
make_field_entry (&field);
cob_decimal_get_field (&d4, curr_field, 0);
return curr_field;
}
Definition at line 1020 of file intrinsic.c.
{
make_field_entry (f);
memcpy (curr_field->data, f->data, f->size);
if (unlikely(offset > 0)) {
calc_ref_mod (curr_field, offset, length);
}
return curr_field;
}
| cob_field* cob_intr_year_to_yyyy | ( | const int | params, |
| ... | |||
| ) |
Definition at line 2583 of file intrinsic.c.
{
cob_field *f;
struct tm *timeptr;
va_list args;
time_t t;
int year;
int interval;
int xqtyear;
int maxyear;
cob_field_attr attr;
cob_field field;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL);
COB_FIELD_INIT (4, NULL, &attr);
make_field_entry (&field);
cob_exception_code = 0;
va_start (args, params);
f = va_arg (args, cob_field *);
year = cob_get_int (f);
if (params > 1) {
f = va_arg (args, cob_field *);
interval = cob_get_int (f);
} else {
interval = 50;
}
if (params > 2) {
f = va_arg (args, cob_field *);
xqtyear = cob_get_int (f);
} else {
t = time (NULL);
timeptr = localtime (&t);
xqtyear = 1900 + timeptr->tm_year;
}
va_end (args);
if (year < 0 || year > 99) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
if (xqtyear < 1601 || xqtyear > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
maxyear = xqtyear + interval;
if (maxyear < 1700 || maxyear > 9999) {
cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
cob_set_int (curr_field, 0);
return curr_field;
}
if (maxyear % 100 >= year) {
year += 100 * (maxyear / 100);
} else {
year += 100 * ((maxyear / 100) - 1);
}
cob_set_int (curr_field, year);
return curr_field;
}
| static int comp_field | ( | const void * | m1, |
| const void * | m2 | ||
| ) | [static] |
| static double COB_NOINLINE intr_get_double | ( | cob_decimal * | d | ) | [static] |
Definition at line 385 of file intrinsic.c.
{
double v;
int n;
v = mpz_get_d (d->value);
n = d->scale;
for (; n > 0; --n) v /= 10;
for (; n < 0; ++n) v *= 10;
return v;
}
| static int leap_year | ( | const int | year | ) | [static] |
Definition at line 370 of file intrinsic.c.
{
return ((year % 4 == 0 && year % 100 != 0) || (year % 400 == 0)) ? 1 : 0;
}
| static void COB_NOINLINE make_double_entry | ( | void | ) | [static] |
Definition at line 310 of file intrinsic.c.
{
unsigned char *s;
curr_field = &calc_field[curr_entry];
curr_attr = &calc_attr[curr_entry];
if (calc_size[curr_entry] < sizeof (double)) {
calc_size[curr_entry] = sizeof (double) + 1;
if (curr_field->data) {
free (curr_field->data);
}
s = cob_malloc (sizeof (double) + 1);
} else {
s = curr_field->data;
memset (s, 0, sizeof (double));
}
curr_attr->type = COB_TYPE_NUMERIC_DOUBLE;
curr_attr->digits = 18;
curr_attr->scale = 9;
curr_attr->flags = COB_FLAG_HAVE_SIGN;
curr_attr->pic = NULL;
curr_field->size = sizeof (double);
curr_field->data = s;
curr_field->attr = curr_attr;
if (++curr_entry >= DEPTH_LEVEL) {
curr_entry = 0;
}
}
| static void COB_NOINLINE make_field_entry | ( | cob_field * | f | ) | [static] |
Definition at line 343 of file intrinsic.c.
{
unsigned char *s;
curr_field = &calc_field[curr_entry];
curr_attr = &calc_attr[curr_entry];
if (f->size > calc_size[curr_entry]) {
calc_size[curr_entry] = f->size + 1;
if (curr_field->data) {
free (curr_field->data);
}
s = cob_malloc (f->size + 1);
} else {
s = curr_field->data;
memset (s, 0, f->size);
}
*curr_field = *f;
*curr_attr = *(f->attr);
curr_field->data = s;
curr_field->attr = curr_attr;
if (++curr_entry >= DEPTH_LEVEL) {
curr_entry = 0;
}
}
cob_field_attr calc_attr[DEPTH_LEVEL] [static] |
Definition at line 75 of file intrinsic.c.
cob_field calc_field[DEPTH_LEVEL] [static] |
Definition at line 74 of file intrinsic.c.
size_t calc_size[DEPTH_LEVEL] [static] |
Definition at line 76 of file intrinsic.c.
cob_field_attr* curr_attr = NULL [static] |
Definition at line 73 of file intrinsic.c.
int curr_entry = 0 [static] |
Definition at line 71 of file intrinsic.c.
cob_field* curr_field = NULL [static] |
Definition at line 72 of file intrinsic.c.
cob_decimal d1 [static] |
Definition at line 68 of file intrinsic.c.
Definition at line 68 of file intrinsic.c.
Definition at line 68 of file intrinsic.c.
Definition at line 68 of file intrinsic.c.
Definition at line 68 of file intrinsic.c.
const int leap_days[] = {0,31,60,91,121,152,182,213,244,274,305,335,366} [static] |
Definition at line 81 of file intrinsic.c.
const int leap_month_days[] = {0,31,29,31,30,31,30,31,31,30,31,30,31} [static] |
Definition at line 83 of file intrinsic.c.
char* locale_buff [static] |
Definition at line 65 of file intrinsic.c.
const int normal_days[] = {0,31,59,90,120,151,181,212,243,273,304,334,365} [static] |
Definition at line 80 of file intrinsic.c.
const int normal_month_days[] = {0,31,28,31,30,31,30,31,31,30,31,30,31} [static] |
Definition at line 82 of file intrinsic.c.
1.7.4