Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Recode cob_decimal_pow function - Fix for #924, #925, #989 - add test cases for power operator #182

Open
wants to merge 3 commits into
base: gcos4gnucobol-3.x
Choose a base branch
from
Open

Recode cob_decimal_pow function - Fix for #924, #925, #989 - add test cases for power operator #182

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
85b1770
Recode cob_decimal_pow function
denishug Sep 25, 2024
ba09a87
20240925 Correct libcob/intrinsic.c code to compile on mac os
denishug Sep 26, 2024
6ce83a5
2024-09-27 Fix C style comment in intrinsic.c (cob_decimal_pow funct…
denishug Sep 27, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
211 changes: 147 additions & 64 deletions libcob/intrinsic.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,7 @@ static mpz_t cob_mpzt;

static mpf_t cob_mpft;
static mpf_t cob_mpft2;
static mpf_t cob_mpft3;
static mpf_t cob_mpft_get;

static mpf_t cob_pi;
Expand Down Expand Up @@ -3153,97 +3154,178 @@ cob_switch_value (const int id)
void
cob_decimal_pow (cob_decimal *pd1, cob_decimal *pd2)
{
cob_uli_t n;
const int sign = mpz_sgn (pd1->value);
int sign_nbr;
int sign_exp;
int power_case;

if (unlikely (pd1->scale == COB_DECIMAL_NAN)) {
if (unlikely(pd1->scale == COB_DECIMAL_NAN)) {
return;
}
if (unlikely (pd2->scale == COB_DECIMAL_NAN)) {
if (unlikely(pd2->scale == COB_DECIMAL_NAN)) {
pd1->scale = COB_DECIMAL_NAN;
return;
}

if (mpz_sgn (pd2->value) == 0) {
/* Exponent is zero */
if (sign == 0) {
/* 0 ^ 0 */
cob_set_exception (COB_EC_SIZE_EXPONENTIATION);
sign_nbr = mpz_sgn(pd1->value);
Copy link
Contributor

@engboris engboris Oct 21, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In order to strictly follow GnuCOBOL's coding style, a space character should be inserted before function calls. And it shouldn't occur before the ; character.

For reference, don't hesitate to look at how the code is written elsewhere in GnuCOBOL's source.

sign_exp = mpz_sgn(pd2->value);

power_case = sign_nbr * sign_exp;
Comment on lines +3170 to +3173
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Those are all "cheap" and don't break for NAN scale - please const those three variables directly at the start of the function.


cob_trim_decimal(pd2);
cob_trim_decimal(pd1);
Comment on lines +3170 to +3176
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can you please reformat to use a space before the parenthesis (also applies to other places)?


switch (power_case) {

case 1:
case -1:
if (pd2->scale != 0 && sign_nbr == -1) {
/* Case number < 0 and decimal exponent --> Error */
pd1->scale = COB_DECIMAL_NAN;
cob_set_exception(COB_EC_SIZE_EXPONENTIATION);
return;
}
mpz_set_ui (pd1->value, 1UL);
pd1->scale = 0;
return;
goto Compute_Power;
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

please reorder that case to have zero first, this can then return while the fall-through of 1/-1 is easier to follow and we don't need the Compute_Power label any more


break;

case 0:
goto Process_case_0;
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

there is a single case for this - please inline instead of using goto

break;
}
if (sign == 0) {
/* Value is zero */
pd1->scale = 0;
return;

Compute_Power:
GitMensch marked this conversation as resolved.
Show resolved Hide resolved
int negat_result = 0 ;

cob_decimal_get_mpf (cob_mpft , pd1);

/* First Check result size */
/* Fix #925 : Avoid GMPLIB CRASH */

mpf_set(cob_mpft3,cob_mpft) ;
if ( sign_nbr == -1) {
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Remove space before condition

mpf_abs(cob_mpft3, cob_mpft3) ;
}
cob_mpf_log10(cob_mpft3, cob_mpft3) ;

cob_trim_decimal (pd2);
cob_decimal_get_mpf (cob_mpft2, pd2) ;
mpf_mul(cob_mpft3, cob_mpft3, cob_mpft2) ;
mpf_abs(cob_mpft3, cob_mpft3) ;

if (sign == -1 && pd2->scale) {
/* Negative exponent and non-integer power */
if ( ! ( mpf_cmp_ui(cob_mpft3,COB_MAX_INTERMEDIATE_FLOATING_SIZE + 1 ) < 0 ) ) {
pd1->scale = COB_DECIMAL_NAN;
cob_set_exception (COB_EC_SIZE_EXPONENTIATION);
return;
cob_set_exception(COB_EC_SIZE_EXPONENTIATION);

return ;
}

cob_trim_decimal (pd1);
/* End Check */

if ( ! (pd2->scale)) {

if (!pd2->scale) {
/* Integer power */
if (!mpz_cmp_ui (pd2->value, 1UL)) {
/* Power is 1 */
cob_uli_t n ;

/* Integer Power */
if (!mpz_cmp_ui(pd2->value, 1UL)) {
/* Power is 1 leave as is */
return;
}
if (mpz_sgn (pd2->value) == -1
&& mpz_fits_slong_p (pd2->value)) {

if (mpz_sgn (pd2->value) == -1 ) {
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Isn't that sign_exp now?

/* Negative power */
mpz_abs (pd2->value, pd2->value);
n = mpz_get_ui (pd2->value);
mpz_pow_ui (pd1->value, pd1->value, n);
if (pd1->scale) {
pd1->scale *= n;
cob_trim_decimal (pd1);
}
mpz_set (pd2->value, pd1->value);
pd2->scale = pd1->scale;
mpz_set_ui (pd1->value, 1UL),
pd1->scale = 0;
cob_decimal_div (pd1, pd2);
cob_trim_decimal (pd1);
return;
mpz_abs (pd2->value, pd2->value); /* to be corrected */

mpf_ui_div(cob_mpft, 1UL, cob_mpft) ;
}
if (mpz_fits_ulong_p (pd2->value)) {

if (mpz_fits_ulong_p (pd2->value)) {
/* Positive power */
n = mpz_get_ui (pd2->value);
mpz_pow_ui (pd1->value, pd1->value, n);
if (pd1->scale) {
pd1->scale *= n;
cob_trim_decimal (pd1);
n = mpz_get_ui (pd2->value);

mpf_pow_ui (cob_mpft, cob_mpft, n);

cob_decimal_set_mpf(pd1, cob_mpft);

cob_trim_decimal(pd1);

return;
}

/*
* At this point we know that :
*
* 1) the result will not crash gmp
* 2) the absolute value of exponent is too large
* to fits ulong
* --> Compute the result sign and Fallthrough to Taylor series compute
*
*/

if (sign_nbr == -1) {
/* Fix #989 */
if (mpz_odd_p(pd2->value)) {
negat_result = 1;
}
return;
}

}
}

/*
* At this stage :
* exponent is non integer OR integer that does not fits tu ulong/slong
* --> Compute with log and exp
* The result sign may only be negative in case of integer exponent
* and is calculated before
*/

/* Compute a ^ b */
mpz_abs(pd1->value, pd1->value);
mpz_abs(pd2->value, pd2->value);

cob_decimal_get_mpf(cob_mpft, pd1);
cob_decimal_get_mpf(cob_mpft2, pd2);

if (sign == -1) {
mpz_abs (pd1->value, pd1->value);
cob_mpf_log(cob_mpft, cob_mpft);
mpf_mul(cob_mpft, cob_mpft, cob_mpft2);

cob_mpf_exp(cob_mpft2, cob_mpft);

/* if negative exponent compute 1 / (a^b) */
if (sign_exp == -1) {
mpf_set_ui(cob_mpft, 1UL);
mpf_div(cob_mpft2, cob_mpft, cob_mpft2);
}
cob_decimal_get_mpf (cob_mpft, pd1);
if (pd2->scale == 1 && !mpz_cmp_ui (pd2->value, 5UL)) {
/* Square root short cut */
mpf_sqrt (cob_mpft2, cob_mpft);
} else {
cob_decimal_get_mpf (cob_mpft2, pd2);
cob_mpf_log (cob_mpft, cob_mpft);
mpf_mul (cob_mpft, cob_mpft, cob_mpft2);
cob_mpf_exp (cob_mpft2, cob_mpft);

cob_decimal_set_mpf(pd1, cob_mpft2);

if (negat_result) {
mpz_neg(pd1->value, pd1->value);
}

cob_trim_decimal(pd1);

return;

Process_case_0:
if (sign_nbr == 0) {
if ( sign_exp == 1) {
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Remove space before condition

/* case 0 ^ Positive number --> zero */
mpz_set_ui(pd1->value, 0UL);
pd1->scale = 0;

}
else {
// FIX #924
pd1->scale = COB_DECIMAL_NAN;
cob_set_exception(COB_EC_SIZE_EXPONENTIATION);
}
}
cob_decimal_set_mpf (pd1, cob_mpft2);
if (sign == -1) {
mpz_neg (pd1->value, pd1->value);
else {
/* Exponent is zero ---> 1 */
mpz_set_ui(pd1->value, 1UL);
pd1->scale = 0;
}

return;
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

please drop "empty" returns (at end without providing a value)

}

/* Indirect field get/put functions */
Expand Down Expand Up @@ -7231,6 +7313,7 @@ cob_init_intrinsic (cob_global *lptr)

mpf_init2 (cob_mpft, COB_MPF_PREC);
mpf_init2 (cob_mpft2, COB_MPF_PREC);
mpf_init2 (cob_mpft3, COB_MPF_PREC);
mpf_init2 (cob_mpft_get, COB_MPF_PREC);
}

Expand Down
Loading
Loading