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

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

Open
wants to merge 4 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 all commits
Commits
Show all changes
4 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
ace2eba
Merge branch 'gcos4gnucobol-3.x' into gcos4gnucobol-3.x
GitMensch Jan 19, 2025
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
5 changes: 5 additions & 0 deletions libcob/ChangeLog
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -140,6 +140,11 @@
* numeric.c, common.c (print_info_detailed): drop COB_LI_IS_LL
in favor of existing COB_32_BIT_LONG

2024-09-25 Denis Hugonnard-Roche <[email protected]>

* intrinsic.c (cob_decimal_pow): recode function in order to
fix bugs #924, #925 and #989

2024-07-27 Chuck Haatvedt <[email protected]>

* screenio.c: In preparation for Multiple Window support
Expand Down
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 @@ -3157,97 +3158,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;
int negat_result = 0 ;

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);
denishug marked this conversation as resolved.
Show resolved Hide resolved
sign_exp = mpz_sgn(pd2->value);

power_case = sign_nbr * sign_exp;
denishug marked this conversation as resolved.
Show resolved Hide resolved

cob_trim_decimal(pd2);
cob_trim_decimal(pd1);
Comment on lines +3174 to +3180
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)?

Copy link
Author

Choose a reason for hiding this comment

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

done


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

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 ) {
denishug marked this conversation as resolved.
Show resolved Hide resolved
/* 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

Copy link
Author

Choose a reason for hiding this comment

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

Done

/* 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)

Copy link
Author

Choose a reason for hiding this comment

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

Done

Copy link
Collaborator

Choose a reason for hiding this comment

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

@denishug it seems you did not commit your changes from yesterday as all of your "done" notes are unchanged. Can you please recheck?

}

/* Indirect field get/put functions */
Expand Down Expand Up @@ -7235,6 +7317,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