|
OpenCOBOL 1.1pre-rel
|
|
OpenCOBOL 1.1pre-rel
|
#include <libcob/common.h>
Go to the source code of this file.
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 | , |
| const int | , | ||
| const int | , | ||
| ... | |||
| ) |
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 | , |
| const int | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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;
}
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;
}
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;
}
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;
}
| cob_field* cob_intr_max | ( | const int | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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.
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 | , |
| ... | |||
| ) |
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 | , |
| const int | , | ||
| const int | , | ||
| ... | |||
| ) |
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 | , |
| const int | , | ||
| const int | , | ||
| ... | |||
| ) |
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 | , |
| ... | |||
| ) |
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;
}
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;
}
| cob_field* cob_intr_variance | ( | const int | , |
| ... | |||
| ) |
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.
| cob_field* cob_intr_year_to_yyyy | ( | const int | , |
| ... | |||
| ) |
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;
}
1.7.4