From 6d03f6fe5f9c93aef3b5fcbc21101bcb3edb8554 Mon Sep 17 00:00:00 2001 From: Denis Hugonnard-Roche Date: Sat, 4 Apr 2026 12:45:52 +0200 Subject: [PATCH 1/3] 2026-04-04 : Denis Hugonnard-Roche: rewrite sin and cos functions for better performance Add all the test in run_functions.at --- libcob/ChangeLog | 11 + libcob/intrinsic.c | 200 ++++++--- tests/testsuite.src/run_functions.at | 650 +++++++++++++++++++++++++++ 3 files changed, 795 insertions(+), 66 deletions(-) diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 91ff9b50e..11edce4ac 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,15 @@ +2026-04-04 Denis Hugonnard-Roche + + * intrinsic.c: rewrite cob_mpf_sin and cob_mpd_cos for + better performances. + + +2026-03-02 Fabrice Le Fessant + + * coblocal.h, common.c, profiling.c: rename is_test to cob_is_test + as it is an external value. + 2025-12-04 Simon Sobisch * fileio.c (indexed_open) [WITH_DB]: if open was successful but checking diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index 0aec31248..5cec9c49a 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -370,6 +370,8 @@ static const struct winlocale wintable[] = #endif +#define COB_COS_DIVIDE_FACTOR 16 + static COB_NOINLINE void setup_cob_pi (void) { @@ -994,102 +996,168 @@ cob_mpf_log10 (mpf_t dst_val, const mpf_t src_val) mpf_clear (dst_temp); } -/* Sin function */ -/* sin (x) = (reduce to pi/2) */ -/* {n = 0, ...} ( (-1 ^ n) * ( x ^ (2n + 1)) / (2n + 1) ) */ +/* Takes an angle X as input and calculates the angle Y reduced to [0;P2/2] */ +/* such that abs( cos(X) ) = abs( cos(Y) ) and abs( sin(X) ) = abs( sin(Y) ) */ +/* and returns the quadrant to which the initial angle belongs (from 0 to 3) */ -static void -cob_mpf_sin (mpf_t dst_val, const mpf_t src_val) +static cob_u16_t +cob_normalize_angle (mpf_t dst, const mpf_t src_val) { - mpf_t vf1, vf2, vf3, vf4, vf5; - mpf_t dst_temp; - cob_uli_t arcquad; - cob_uli_t n; - int sign; - - mpf_init2 (dst_temp, COB_MPF_PREC); - if (!set_cob_pi) setup_cob_pi (); + mpf_t half_pi; + mpf_t vf1; + mpf_t k ; + mpz_t q ; + int sign ; + unsigned long n ; + mpf_init2 (half_pi, COB_MPF_PREC); mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (vf2, COB_MPF_PREC); - mpf_init2 (vf3, COB_MPF_PREC); - mpf_init2 (vf4, COB_MPF_PREC); - mpf_init2 (vf5, COB_MPF_PREC); - sign = mpf_sgn (src_val); + mpf_init2 (k, COB_MPF_PREC); + mpz_init2 (q, COB_MPF_PREC); - mpf_abs (vf4, src_val); - mpf_set (vf3, cob_pi); - mpf_div_2exp (vf3, vf3, 1UL); - mpf_div (vf1, vf4, vf3); - mpf_floor (vf4, vf1); - - if (mpf_cmp_ui (vf4, 4UL) >= 0) { - mpf_div_2exp (vf2, vf4, 2UL); - mpf_floor (vf2, vf2); - mpf_mul_2exp (vf2, vf2, 2UL); - mpf_sub (vf2, vf4, vf2); + mpf_set (dst, src_val); + + sign = mpf_sgn (src_val); + if ( sign == 0 ) { + mpf_set_ui (dst, 0UL); + return(0); } else { - mpf_set (vf2, vf4); + if ( sign == -1 ) { + mpf_neg (dst, dst); + } } + /* Now dst contains abs(src_val) */ - arcquad = mpf_get_ui (vf2); - mpf_sub (vf2, vf1, vf4); - mpf_mul (vf4, vf3, vf2); - - if (arcquad > 1) { - sign = -sign; - } - if (arcquad & 1) { - mpf_sub (vf4, vf3, vf4); + /* get pi/2 */ + mpf_div_2exp (half_pi, cob_pi, 1UL); + if ( mpf_cmp (dst, half_pi) == 0) { + if ( sign == -1 ) { + return(2); + } + return(0); } - mpf_mul (vf3, vf4, vf4); - mpf_neg (vf3, vf3); - n = 1; - mpf_set_ui (vf2, 1UL); - mpf_set_ui (dst_temp, 1UL); + /* Get Quadrant */ + mpf_div (vf1, dst, half_pi); + mpf_trunc (k, vf1); + mpz_set_f(q, k); + mpz_mod_ui (q, q, 4UL); + n = mpz_get_ui (q); - do { - ++n; - mpf_div_ui (vf2, vf2, n); - ++n; - mpf_div_ui (vf2, vf2, n); - mpf_mul (vf2, vf2, vf3); - mpf_set (vf5, dst_temp); - mpf_add (dst_temp, dst_temp, vf2); - } while (!mpf_eq (vf5, dst_temp, COB_MPF_PREC)); + /* Compute the resulting angle reduce on [0;PI/2] */ + /* dst - k*Pi/2 */ + mpf_mul (vf1, k, half_pi); + mpf_sub (dst, dst, vf1); - mpf_mul (dst_temp, dst_temp, vf4); - if (sign < 0) { - mpf_neg (dst_temp, dst_temp); + /* Process quadrant */ + if ( n & 1) { + /* if n odd we have to get the complementary angle */ + mpf_sub (dst, half_pi, dst); } - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); + if ( sign < 0 ) { + switch (n) { + case 0 : n = 3 ; break; + case 1 : n = 2 ; break; + case 2 : n = 1 ; break; + case 3 : n = 0 ; break; + } + } - mpf_clear (vf5); - mpf_clear (vf4); - mpf_clear (vf3); - mpf_clear (vf2); + mpf_clear (half_pi); mpf_clear (vf1); + mpf_clear (k); + mpz_clear (q); + + return(n); } /* Cos function */ -/* cos (x) = sin ((pi / 2) - x) */ +/* cos(x) = ( 1 - x^2/2 + x^4/4! - x^6/6! ...*/ +/* (x) = (reduced to pi/2) */ +/* The angle is divided by 2^COB_COS_DIVIDE to make it closer to 0 */ +/* We use the equality cos(2X) = 2*cos^2(X)-1 to have the final value*/ static void cob_mpf_cos (mpf_t dst_val, const mpf_t src_val) { - mpf_t vf1; + mpf_t term, val_serie, angle; + cob_u16_t arcquad; + cob_uli_t n; + cob_uli_t j; + + if (!set_cob_pi) setup_cob_pi (); + + mpf_init2 (term, COB_MPF_PREC); + mpf_init2 (val_serie, COB_MPF_PREC); + mpf_init2 (angle, COB_MPF_PREC); + + arcquad = cob_normalize_angle (angle, src_val); + + /* Divide nn time by 2 */ + mpf_div_2exp (angle, angle, COB_COS_DIVIDE_FACTOR ); + + mpf_mul (angle, angle, angle); + + mpf_set_si (term, -1L); + + /* compute first term */ + mpf_set (dst_val, angle); + mpf_div_ui (dst_val, dst_val, 2UL); + mpf_neg (dst_val, dst_val); + mpf_set (term, dst_val); /* init first term to -x^2/2 */ + mpf_add_ui (dst_val, dst_val, 1UL); + + n = 4; + do { + mpf_set (val_serie, dst_val); + mpf_mul (term, term, angle); + j = n - 1UL; + j = j * n; + mpf_div_ui (term, term, j); + mpf_neg (term, term); + + mpf_add ( dst_val, dst_val, term); + n = n + 2; + } while (!mpf_eq (dst_val, val_serie, COB_MPF_PREC)); + + /* compute 2*n^2 -1 */ + for ( int i = 0 ; i < COB_COS_DIVIDE_FACTOR; i++ ) { + mpf_mul (dst_val, dst_val, dst_val); + mpf_mul_ui (dst_val, dst_val, 2UL); + mpf_sub_ui (dst_val, dst_val, 1UL); + } + + if (arcquad == 1 || arcquad == 2 ) { + mpf_neg (dst_val, dst_val); + } + + mpf_clear (term); + mpf_clear (angle); + mpf_clear (val_serie); +} + +/* sin function */ +/* sin(X) = cos( PI/2 - X) */ + +static void +cob_mpf_sin (mpf_t dst_val, const mpf_t src_val) +{ + mpf_t vf1; mpf_init2 (vf1, COB_MPF_PREC); + if (!set_cob_pi) setup_cob_pi (); mpf_set (vf1, cob_pi); mpf_div_2exp (vf1, vf1, 1UL); - mpf_sub (vf1, vf1, src_val); - cob_mpf_sin (dst_val, vf1); + + if (mpf_cmp_ui (src_val, 0UL) != 0) { + mpf_sub (vf1, vf1, src_val); + } + + cob_mpf_cos (dst_val, vf1); mpf_clear (vf1); } diff --git a/tests/testsuite.src/run_functions.at b/tests/testsuite.src/run_functions.at index 452f65b79..946cf31b6 100644 --- a/tests/testsuite.src/run_functions.at +++ b/tests/testsuite.src/run_functions.at @@ -4657,3 +4657,653 @@ Return value '5'], []) AT_CLEANUP + +AT_SETUP([FUNCTION SIN]) +AT_KEYWORDS([functions additionals tests for SIN]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(37) COMP-3. + PROCEDURE DIVISION. + * + * SIN TESTS + * + PERFORM QUADRANT-1 . + * + PERFORM QUADRANT-2 . + * + PERFORM QUADRANT-3 . + * + PERFORM QUADRANT-4 . + * + PERFORM OTHERS . + * + GOBACK. + * + QUADRANT-1 . + *------------ + * + MOVE + SIN (0) TO Y + IF Y NOT = 0 + THEN + DISPLAY 'Q-1-1 ' '<' Y '> != 0'. + * + MOVE + SIN ( PI() / 6 ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-2 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( PI() / 4 ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-3 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / 3 ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-4 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / 2 ) TO Y . + IF Y NOT = 1 + THEN + DISPLAY 'Q-1-5 ' '<' Y '> != 1'. + * + * ROTATE 6*PI + * + MOVE + SIN ( PI() / 6 + 6 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-6 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( PI() / 4 + 6 * PI() ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-7 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / 3 + 6 * PI() ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-8 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / 2 + 6 * PI() ) TO Y . + IF Y NOT = 1 + THEN + DISPLAY 'Q-1-9 ' '<' Y '> != 1'. + * + QUADRANT-2 . + *------------ + * + MOVE + SIN ( 5/6 * (PI() ) ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-2-1 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( 3 * PI() / 4 ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-2 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 2 * PI() / 3 ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-3 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-2-4 ' '<' Y + '> != 0'. + * + MOVE + SIN ( -PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-2-4-1 ' '<' Y + '> != 0'. + * + * ROTATE 4*PI + * + MOVE + SIN ( 5 /6 * PI() + 4 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-2-5 ' '<' Y '> != 0.5'. + * + MOVE + SIN ( 3 * PI() / 4 + 4 * PI() ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-6 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 2 * PI() / 3 + 4 * PI) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-7 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() + 4 * PI) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-2-8 ' '<' Y + '> != 0'. + * + QUADRANT-3 . + *------------ + * + MOVE + SIN ( 7 * PI() / 6 ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-1 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( 5 * PI() / 4 ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-2 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 4 * PI() / 3 ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-3 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + * ROTATE 4*PI + * + MOVE + SIN ( 7 * PI() / 6 + 4 * PI() ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-4 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( 5 * PI() / 4 + 4 * PI) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-5 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( 4 * PI() / 3 + 4 * PI) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-6 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + QUADRANT-4 . + *------------ + * + MOVE + SIN ( 2* PI() ) TO Y + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-1 ' '<' Y '> != 0'. + * + MOVE + SIN ( PI() / -6 ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-4-2 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( PI() / -4 ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-3 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / -3 ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-4 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / -2 ) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-4-5 ' '<' Y '> != -1'. + * + * ROTATE 2*PI + * + MOVE + SIN ( 2* PI() + 2 * PI() ) TO Y + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-6 ' '<' Y '> != 0'. + * + MOVE + SIN ( 11 / 6 * PI() ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-4-7 ' '<' Y '> != -0.5'. + * + MOVE + SIN ( PI() / -4 + 2 * PI()) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-8 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + SIN ( PI() / -3 + 2 * PI() ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-9 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + SIN ( PI() / -2 + 2 * PI()) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-4-10 ' '<' Y '> != -1'. + * + OTHERS . + *-------- + * + MOVE + SIN ( 50 ) TO Y + IF Y NOT = -0.2623748537039287859143936469126225458 + THEN + DISPLAY 'O-1 ' '<' Y + '> != -0.2623748537039287859143936469126225458'. + * + MOVE + SIN ( 102 ) TO Y + IF Y NOT = 0.9948267913584063974966258254280299703 + THEN + DISPLAY 'O-2 ' '<' Y + '> != 0.9948267913584063974966258254280299703'. + * + MOVE + SIN ( -91 ) TO Y + IF Y NOT = -0.1059875117511568500202081631463178801 + THEN + DISPLAY 'O-3 ' '<' Y + '> != -0.1059875117511568500202081631463178801'. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([FUNCTION COS]) +AT_KEYWORDS([functions additionals tests for COS]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC S9V9(37) COMP-3. + PROCEDURE DIVISION. + * + * COS TESTS + * + PERFORM QUADRANT-1 . + * + PERFORM QUADRANT-2 . + * + PERFORM QUADRANT-3 . + * + PERFORM QUADRANT-4 . + * + PERFORM OTHERS . + * + GOBACK. + * + QUADRANT-1 . + *------------ + * + MOVE + COS (0) TO Y + IF Y NOT = 1 + THEN + DISPLAY 'Q-1-1 ' '<' Y '> != 1'. + * + MOVE + COS ( PI() * (1/6) ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-2 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (1/4) ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-3 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() * (1/3) ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-4 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( PI() * (1/2) ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-1-5 ' '<' Y '> != 0'. + * + * ROTATE 6*PI + * + MOVE + COS ( PI() * (1/6) + 6 * PI() ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-1-6 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (1/4) + 6 * PI() ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-1-7 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() * (1/3) + 6 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-1-8 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( PI() * (1/2) + 6 * PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-1-9 ' '<' Y '> != 0'. + * + QUADRANT-2 . + *------------ + * + MOVE + COS ( PI() * (5/6) ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-1 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (3/4) ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-2 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( (PI() * 2) / 3 ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-2-3 ' '<' Y + '> != -0.5'. + * + MOVE + COS ( PI() ) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-2-4 ' '<' Y + '> != -1'. + * + * ROTATE 4*PI + * + MOVE + COS ( PI() * (5/6) + 4 * PI() ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-2-5 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() * (3/4) + 4 * PI()) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-2-6 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( (PI() * 2) / 3 + 4 * PI) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-2-7 ' '<' Y + '> != -0.5'. + * + MOVE + COS ( PI() + 4 * PI) TO Y . + IF Y NOT = -1 + THEN + DISPLAY 'Q-2-8 ' '<' Y + '> != -1'. + * + QUADRANT-3 . + *------------ + * + MOVE + COS ( (-1/2) * PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-3-0 ' '<' Y + '> != 0'. + * + MOVE + COS ( 7 * PI() / 6 ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-1 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( 5 * PI() / 4 ) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-2 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( 4 * PI() * (1/3) ) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-3 ' '<' Y + '> != -0.5'. + * + * ROTATE 4*PI + * + MOVE + COS ( 7 * PI() / 6 + 4 * PI() ) TO Y . + IF Y NOT = -0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-3-4 ' '<' Y + '> != -0.8660254037844386467637231707529361834'. + * + MOVE + COS ( 5 * PI() / 4 + 4 * PI) TO Y . + IF Y NOT = -0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-3-5 ' '<' Y + '> != -0.7071067811865475244008443621048490392'. + * + MOVE + COS ( 4 * PI() * (1/3) + 4 * PI) TO Y . + IF Y NOT = -0.5 + THEN + DISPLAY 'Q-3-6 ' '<' Y + '> != -0.5'. + * + QUADRANT-4 . + *------------ + * + MOVE + COS ( 2* PI() ) TO Y + IF Y NOT = 1 + THEN + DISPLAY 'Q-4-1 ' '<' Y '> != 1'. + * + MOVE + COS ( PI() / -6 ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-2 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() / -4 ) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-3 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() * (-1/3) ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-4-4 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( (-1/2) * PI() ) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-5 ' '<' Y '> != 0'. + * + * ROTATE 2*PI + * + MOVE + COS ( 2* PI() + 2 * PI() ) TO Y + IF Y NOT = 1 + THEN + DISPLAY 'Q-4-6 ' '<' Y '> != 1'. + * + MOVE + COS ( 11 / 6 * PI() ) TO Y . + IF Y NOT = 0.8660254037844386467637231707529361834 + THEN + DISPLAY 'Q-4-7 ' '<' Y + '> != 0.8660254037844386467637231707529361834'. + * + MOVE + COS ( PI() / -4 + 2 * PI()) TO Y . + IF Y NOT = 0.7071067811865475244008443621048490392 + THEN + DISPLAY 'Q-4-8 ' '<' Y + '> != 0.7071067811865475244008443621048490392'. + * + MOVE + COS ( PI() / -3 + 2 * PI() ) TO Y . + IF Y NOT = 0.5 + THEN + DISPLAY 'Q-4-9 ' '<' Y + '> != 0.5'. + * + MOVE + COS ( PI() / -2 + 2 * PI()) TO Y . + IF Y NOT = 0 + THEN + DISPLAY 'Q-4-10 ' '<' Y '> != 0'. + * + OTHERS . + *-------- + * + MOVE + COS ( 6283 ) TO Y + IF Y NOT = 0.9828796996364299824023342356924739561 + THEN + DISPLAY 'O-1 ' '<' Y + '> != 0.9828796996364299824023342356924739561'. + * + MOVE + COS ( 7853 ) TO Y + IF Y NOT = 0.5556647922689408634262568334887896883 + THEN + DISPLAY 'O-2 ' '<' Y + '> != 0.5556647922689408634262568334887896883'. + * + MOVE + COS ( 9424 ) TO Y + IF Y NOT = 0.7123462077917668361340766590450501725 + THEN + DISPLAY 'O-3 ' '<' Y + '> != 0.7123462077917668361340766590450501725'. + * + MOVE + COS ( 10995 ) TO Y . + IF Y NOT = 0.8395795367483645308029333859038237152 + THEN + DISPLAY 'O-4 ' '<' Y + '> != 0.8395795367483645308029333859038237152'. + MOVE + COS ( -6283 ) TO Y + IF Y NOT = 0.9828796996364299824023342356924739561 + THEN + DISPLAY 'O-5 ' '<' Y + '> != 0.9828796996364299824023342356924739561'. + * + MOVE + COS ( -7853 ) TO Y + IF Y NOT = 0.5556647922689408634262568334887896883 + THEN + DISPLAY 'O-6 ' '<' Y + '> != 0.5556647922689408634262568334887896883'. + * + MOVE + COS ( -9424 ) TO Y + IF Y NOT = 0.7123462077917668361340766590450501725 + THEN + DISPLAY 'O-7 ' '<' Y + '> != 0.7123462077917668361340766590450501725'. + * + MOVE + COS ( -10995 ) TO Y . + IF Y NOT = 0.8395795367483645308029333859038237152 + THEN + DISPLAY 'O-8 ' '<' Y + '> != 0.8395795367483645308029333859038237152'. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + From 54a36aebbb044e2a7338664ebe1a51af3dab46d4 Mon Sep 17 00:00:00 2001 From: Denis Hugonnard-Roche Date: Mon, 6 Apr 2026 11:13:35 +0200 Subject: [PATCH 2/3] 2026-04-06: Denis Hugonnard-Roche : Fix typo and Changelog add CHECK-PERF to sin and cos tests --- libcob/ChangeLog | 8 ++++--- libcob/intrinsic.c | 33 ++++++++++++------------- tests/testsuite.src/run_functions.at | 36 +++++++++++++++++++++++----- 3 files changed, 52 insertions(+), 25 deletions(-) diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 11edce4ac..0de83b4d6 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,9 +1,11 @@ 2026-04-04 Denis Hugonnard-Roche - * intrinsic.c: rewrite cob_mpf_sin and cob_mpd_cos for - better performances. - + * intrinsic.c (cob_normalize_angle): new_function + * intrinsic.c (cob_mpf_cos): better performabce with use of + cob_normalize_angle + * intrinsic.c (cob_mpf_sin): better performabce with use of + cob_mpf_sin 2026-03-02 Fabrice Le Fessant diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index 5cec9c49a..0516fc8be 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -1,5 +1,5 @@ /* - Copyright (C) 2005-2012, 2014-2024 Free Software Foundation, Inc. + Copyright (C) 2005-2012, 2014-2026 Free Software Foundation, Inc. Written by Roger While, Simon Sobisch, Edward Hart, Brian Tiffin This file is part of GnuCOBOL. @@ -1018,11 +1018,11 @@ cob_normalize_angle (mpf_t dst, const mpf_t src_val) mpf_set (dst, src_val); sign = mpf_sgn (src_val); - if ( sign == 0 ) { + if (sign == 0) { mpf_set_ui (dst, 0UL); return(0); } else { - if ( sign == -1 ) { + if (sign == -1) { mpf_neg (dst, dst); } } @@ -1030,14 +1030,13 @@ cob_normalize_angle (mpf_t dst, const mpf_t src_val) /* get pi/2 */ mpf_div_2exp (half_pi, cob_pi, 1UL); - if ( mpf_cmp (dst, half_pi) == 0) { + if (mpf_cmp (dst, half_pi) == 0) { if ( sign == -1 ) { return(2); } return(0); } - /* Get Quadrant */ mpf_div (vf1, dst, half_pi); mpf_trunc (k, vf1); @@ -1051,7 +1050,7 @@ cob_normalize_angle (mpf_t dst, const mpf_t src_val) mpf_sub (dst, dst, vf1); /* Process quadrant */ - if ( n & 1) { + if (n & 1) { /* if n odd we have to get the complementary angle */ mpf_sub (dst, half_pi, dst); } @@ -1085,7 +1084,6 @@ cob_mpf_cos (mpf_t dst_val, const mpf_t src_val) mpf_t term, val_serie, angle; cob_u16_t arcquad; cob_uli_t n; - cob_uli_t j; if (!set_cob_pi) setup_cob_pi (); @@ -1111,26 +1109,29 @@ cob_mpf_cos (mpf_t dst_val, const mpf_t src_val) n = 4; do { + const cob_uli_t j = (n-1UL) * n; + mpf_set (val_serie, dst_val); mpf_mul (term, term, angle); - j = n - 1UL; - j = j * n; mpf_div_ui (term, term, j); mpf_neg (term, term); mpf_add ( dst_val, dst_val, term); - n = n + 2; + n += 2; } while (!mpf_eq (dst_val, val_serie, COB_MPF_PREC)); - /* compute 2*n^2 -1 */ - for ( int i = 0 ; i < COB_COS_DIVIDE_FACTOR; i++ ) { - mpf_mul (dst_val, dst_val, dst_val); - mpf_mul_ui (dst_val, dst_val, 2UL); - mpf_sub_ui (dst_val, dst_val, 1UL); + /* compute 2*n^2 -1 n times */ + { + int i ; + for (i = 0 ; i < COB_COS_DIVIDE_FACTOR; i++) { + mpf_mul (dst_val, dst_val, dst_val); + mpf_mul_ui (dst_val, dst_val, 2UL); + mpf_sub_ui (dst_val, dst_val, 1UL); + } } - if (arcquad == 1 || arcquad == 2 ) { + if (arcquad == 1 || arcquad == 2) { mpf_neg (dst_val, dst_val); } diff --git a/tests/testsuite.src/run_functions.at b/tests/testsuite.src/run_functions.at index 946cf31b6..82eee3dd4 100644 --- a/tests/testsuite.src/run_functions.at +++ b/tests/testsuite.src/run_functions.at @@ -4658,7 +4658,7 @@ Return value '5'], []) AT_CLEANUP -AT_SETUP([FUNCTION SIN]) +AT_SETUP([FUNCTION SIN additionnals tests]) AT_KEYWORDS([functions additionals tests for SIN]) AT_DATA([prog.cob], [ @@ -4672,9 +4672,24 @@ AT_DATA([prog.cob], [ DATA DIVISION. WORKING-STORAGE SECTION. 01 Y PIC S9V9(37) COMP-3. + 01 N PIC 9(04) COMP-5. PROCEDURE DIVISION. * * SIN TESTS + * + MOVE 1 TO N. + >> IF CHECK-PERF IS DEFINED + MOVE 2500 TO N. + >> END-IF + * + PERFORM DO-TEST N TIMES . + * + GOBACK. + * + DO-TEST . + *--------- + * + PERFORM QUADRANT-1 . * PERFORM QUADRANT-1 . * @@ -4685,8 +4700,6 @@ AT_DATA([prog.cob], [ PERFORM QUADRANT-4 . * PERFORM OTHERS . - * - GOBACK. * QUADRANT-1 . *------------ @@ -4962,7 +4975,7 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP -AT_SETUP([FUNCTION COS]) +AT_SETUP([FUNCTION COS additionnals tests]) AT_KEYWORDS([functions additionals tests for COS]) AT_DATA([prog.cob], [ @@ -4976,9 +4989,22 @@ AT_DATA([prog.cob], [ DATA DIVISION. WORKING-STORAGE SECTION. 01 Y PIC S9V9(37) COMP-3. + 01 N PIC 9(04) COMP-5. PROCEDURE DIVISION. * * COS TESTS + * + MOVE 1 TO N. + >> IF CHECK-PERF IS DEFINED + MOVE 2500 TO N. + >> END-IF + * + PERFORM DO-TEST N TIMES . + * + GOBACK. + * + DO-TEST . + *--------- * PERFORM QUADRANT-1 . * @@ -4989,8 +5015,6 @@ AT_DATA([prog.cob], [ PERFORM QUADRANT-4 . * PERFORM OTHERS . - * - GOBACK. * QUADRANT-1 . *------------ From b2e99607fa4047c1ddc69b557e7912c251ce128f Mon Sep 17 00:00:00 2001 From: Denis Hugonnard-Roche Date: Fri, 10 Apr 2026 17:08:19 +0200 Subject: [PATCH 3/3] 2026-04-10: Denis Hugonnard-Roche : Trigo functions Add cob_half_pi constant and use in all functions Add tests to atan, acos, asin to cover all the case Fix typo, some simplications and optimization --- libcob/ChangeLog | 8 + libcob/intrinsic.c | 84 ++++---- tests/testsuite.src/run_functions.at | 284 ++++++++++++++++++++++++++- 3 files changed, 325 insertions(+), 51 deletions(-) diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 0de83b4d6..e4b8ba7f1 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,12 @@ +2026-04-10 Denis Hugonnard-Roche + + * intrinsic.c (setup_cob_pi, cob_exit_intrinsic): add cob_half_pi + constant + * intrinsic.c (cob_normalize_angle): simplify & optimize, use + cob_halp_pi + * intrinsic.c (cob_mpf_xxxx: sin, cos, acos, asin, atan): use cob_half_pi + 2026-04-04 Denis Hugonnard-Roche * intrinsic.c (cob_normalize_angle): new_function diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c index 0516fc8be..7cb57a27d 100644 --- a/libcob/intrinsic.c +++ b/libcob/intrinsic.c @@ -1,6 +1,7 @@ /* Copyright (C) 2005-2012, 2014-2026 Free Software Foundation, Inc. - Written by Roger While, Simon Sobisch, Edward Hart, Brian Tiffin + Written by Roger While, Simon Sobisch, Edward Hart, Brian Tiffin, + Denis Hugonnard-Roche This file is part of GnuCOBOL. @@ -100,6 +101,7 @@ static mpf_t cob_mpft2; static mpf_t cob_mpft_get; static mpf_t cob_pi; +static mpf_t cob_half_pi; static mpf_t cob_sqrt_two; static mpf_t cob_log_half; static mpf_t cob_log_ten; @@ -399,6 +401,11 @@ setup_cob_pi (void) mpf_init2 (cob_pi, COB_PI_LEN); mpf_set_str (cob_pi, cob_pi_str, 10); + + mpf_init2 (cob_half_pi, COB_PI_LEN); + mpf_set (cob_half_pi, cob_pi); + mpf_div_ui (cob_half_pi, cob_pi, 2UL); + set_cob_pi = 1; } @@ -1003,42 +1010,29 @@ cob_mpf_log10 (mpf_t dst_val, const mpf_t src_val) static cob_u16_t cob_normalize_angle (mpf_t dst, const mpf_t src_val) { - mpf_t half_pi; mpf_t vf1; mpf_t k ; mpz_t q ; - int sign ; unsigned long n ; - mpf_init2 (half_pi, COB_MPF_PREC); - mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (k, COB_MPF_PREC); - mpz_init2 (q, COB_MPF_PREC); - - mpf_set (dst, src_val); - - sign = mpf_sgn (src_val); + const int sign = mpf_sgn (src_val); if (sign == 0) { mpf_set_ui (dst, 0UL); - return(0); - } else { - if (sign == -1) { - mpf_neg (dst, dst); - } + return 0 ; } - /* Now dst contains abs(src_val) */ - /* get pi/2 */ - mpf_div_2exp (half_pi, cob_pi, 1UL); - if (mpf_cmp (dst, half_pi) == 0) { - if ( sign == -1 ) { - return(2); - } - return(0); + mpf_set (dst, src_val); + if (sign == -1) { + mpf_neg (dst, dst); } + /* Now dst contains abs(src_val) */ + + mpf_init2 (vf1, COB_MPF_PREC); + mpf_init2 (k, COB_MPF_PREC); + mpz_init2 (q, COB_MPZ_DEF); /* Get Quadrant */ - mpf_div (vf1, dst, half_pi); + mpf_div (vf1, dst, cob_half_pi); mpf_trunc (k, vf1); mpz_set_f(q, k); mpz_mod_ui (q, q, 4UL); @@ -1046,30 +1040,24 @@ cob_normalize_angle (mpf_t dst, const mpf_t src_val) /* Compute the resulting angle reduce on [0;PI/2] */ /* dst - k*Pi/2 */ - mpf_mul (vf1, k, half_pi); + mpf_mul (vf1, k, cob_half_pi); mpf_sub (dst, dst, vf1); /* Process quadrant */ if (n & 1) { /* if n odd we have to get the complementary angle */ - mpf_sub (dst, half_pi, dst); + mpf_sub (dst, cob_half_pi, dst); } - if ( sign < 0 ) { - switch (n) { - case 0 : n = 3 ; break; - case 1 : n = 2 ; break; - case 2 : n = 1 ; break; - case 3 : n = 0 ; break; - } + if (sign == -1) { + n = 3 - n ; } - mpf_clear (half_pi); mpf_clear (vf1); mpf_clear (k); mpz_clear (q); - return(n); + return n; } /* Cos function */ @@ -1116,7 +1104,7 @@ cob_mpf_cos (mpf_t dst_val, const mpf_t src_val) mpf_div_ui (term, term, j); mpf_neg (term, term); - mpf_add ( dst_val, dst_val, term); + mpf_add (dst_val, dst_val, term); n += 2; } while (!mpf_eq (dst_val, val_serie, COB_MPF_PREC)); @@ -1147,13 +1135,13 @@ static void cob_mpf_sin (mpf_t dst_val, const mpf_t src_val) { mpf_t vf1; - mpf_init2 (vf1, COB_MPF_PREC); if (!set_cob_pi) setup_cob_pi (); - mpf_set (vf1, cob_pi); - mpf_div_2exp (vf1, vf1, 1UL); + mpf_init2 (vf1, COB_MPF_PREC); + /* compute complementary angle = PI/2 - Angle */ + mpf_set (vf1, cob_half_pi); if (mpf_cmp_ui (src_val, 0UL) != 0) { mpf_sub (vf1, vf1, src_val); } @@ -1205,15 +1193,14 @@ cob_mpf_atan (mpf_t dst_val, const mpf_t src_val) mpf_add_ui (vf3, cob_sqrt_two, 1UL); if (mpf_cmp (vf1, vf3) > 0) { - mpf_set (dst_temp, cob_pi); - mpf_div_2exp (dst_temp, dst_temp, 1UL); + mpf_set (dst_temp, cob_half_pi); mpf_ui_div (vf1, 1UL, vf1); mpf_neg (vf1, vf1); } else { mpf_sub_ui (vf4, cob_sqrt_two, 1UL); if (mpf_cmp (vf1, vf4) > 0) { - mpf_set (dst_temp, cob_pi); - mpf_div_2exp (dst_temp, dst_temp, 2UL); + mpf_set (dst_temp, cob_half_pi); + mpf_div_2exp (dst_temp, dst_temp, 1UL); mpf_sub_ui (vf3, vf1, 1UL); mpf_add_ui (vf4, vf1, 1UL); mpf_div (vf1, vf3, vf4); @@ -1261,8 +1248,8 @@ cob_mpf_asin (mpf_t dst_val, const mpf_t src_val) if (!set_cob_pi) setup_cob_pi (); if (!mpf_cmp_ui (src_val, 1UL) || !mpf_cmp_si (src_val, -1L)) { - mpf_set (dst_temp, cob_pi); - mpf_div_ui (dst_temp, dst_temp, 2UL); + mpf_set (dst_temp, cob_half_pi); + mpf_div_ui (dst_temp, dst_temp, 1UL); if (mpf_sgn (src_val) < 0) { mpf_neg (dst_temp, dst_temp); } @@ -1309,8 +1296,8 @@ cob_mpf_acos (mpf_t dst_val, const mpf_t src_val) if (!set_cob_pi) setup_cob_pi (); if (!mpf_sgn (src_val)) { - mpf_set (dst_temp, cob_pi); - mpf_div_ui (dst_temp, dst_temp, 2UL); + mpf_set (dst_temp, cob_half_pi); + mpf_div_ui (dst_temp, dst_temp, 1UL); mpf_set (dst_val, dst_temp); mpf_clear (dst_temp); return; @@ -7258,6 +7245,7 @@ cob_exit_intrinsic (void) } if (set_cob_pi) { mpf_clear (cob_pi); + mpf_clear (cob_half_pi); } if (set_cob_log_half) { mpf_clear (cob_log_half); diff --git a/tests/testsuite.src/run_functions.at b/tests/testsuite.src/run_functions.at index 82eee3dd4..7876ebc7c 100644 --- a/tests/testsuite.src/run_functions.at +++ b/tests/testsuite.src/run_functions.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2014-2026 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart ## ## This file is part of GnuCOBOL. @@ -4659,7 +4659,7 @@ AT_CLEANUP AT_SETUP([FUNCTION SIN additionnals tests]) -AT_KEYWORDS([functions additionals tests for SIN]) +AT_KEYWORDS([functions SIN]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -4976,7 +4976,7 @@ AT_CLEANUP AT_SETUP([FUNCTION COS additionnals tests]) -AT_KEYWORDS([functions additionals tests for COS]) +AT_KEYWORDS([functions COS]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -5331,3 +5331,281 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP + +AT_SETUP([function ATAN additionals tests]) +AT_KEYWORDS([functions ATAN]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 BIG PIC S9(38) COMP-3. + 01 Z PIC S9V9(37) COMP-3. + 01 X PIC S9V9(37) COMP-3. + * + PROCEDURE DIVISION. + * + * ATAN TESTS + * + + MOVE 99999999999999999999999999999999999999 TO BIG. + COMPUTE Z = ATAN(BIG) + IF Z NOT = 1.5707963267948966192313216916397514420 + THEN + DISPLAY '1 : ' Z + ' != 1.5707963267948966192313216916397514420'. + * + MOVE -99999999999999999999999999999999999999 TO BIG. + COMPUTE Z = ATAN(BIG) + IF Z NOT = -1.5707963267948966192313216916397514420 + THEN + DISPLAY '2 : ' Z + ' != -1.5707963267948966192313216916397514420'. + * + MOVE 0 TO BIG. + COMPUTE Z = ATAN(BIG) + IF Z NOT = 0 + THEN + DISPLAY '3 : ' Z + ' != 0'. + * + MOVE 2 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = 1.1071487177940905030170654601785370400 + THEN + DISPLAY '4 : ' Z + ' != 1.1071487177940905030170654601785370400'. + * + MOVE -2 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = -1.1071487177940905030170654601785370400 + THEN + DISPLAY '5 : ' Z + ' != -1.1071487177940905030170654601785370400'. + * + MOVE 0.3 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = 0.2914567944778670919956046214328911935 + THEN + DISPLAY '6 : ' Z + ' != 0.2914567944778670919956046214328911935'. + * + MOVE -0.3 TO X. + COMPUTE Z = ATAN(X) + IF Z NOT = -0.2914567944778670919956046214328911935 + THEN + DISPLAY '7 : ' Z + ' != -0.2914567944778670919956046214328911935'. + * + GOBACK. + +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([function ACOS additionals tests]) +AT_KEYWORDS([functions ACOS]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9V9(37) COMP-3. + 01 X PIC S99V9(36) COMP-3. + 01 E-LOC PIC X(50) . + 01 E-LOC-PREV PIC X(50) . + 01 E-STATUS PIC X(50) . + * + PROCEDURE DIVISION. + * + * ACOS TESTS + * + MOVE 2 TO X . + COMPUTE Z = ACOS(X) + MOVE EXCEPTION-STATUS TO E-STATUS . + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-STATUS NOT = 'EC-ARGUMENT-FUNCTION' + THEN + DISPLAY '1-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE -2 TO X . + COMPUTE Z = ACOS(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC = E-LOC-PREV + THEN + DISPLAY '2-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE 0 TO X . + COMPUTE Z = ACOS(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '3-1 : Should not have raise exception' + END-IF. + IF Z NOT = 1.5707963267948966192313216916397514420 + THEN + DISPLAY '3-2 : <' Z + '> != 1.5707963267948966192313216916397514420' + END-IF. + * + MOVE 1 TO X . + COMPUTE Z = ACOS(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '4-1 : Should not have raise exception' + END-IF. + IF Z NOT = 0 + THEN + DISPLAY '4-2 : <' Z + '> != 0' + END-IF. + * + MOVE -1 TO X . + COMPUTE Z = ACOS(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '5-1 : Should not have raise exception' + END-IF. + IF Z NOT = 3.1415926535897932384626433832795028841 + THEN + DISPLAY '5-2 : <' Z + '> != 3.1415926535897932384626433832795028841' + END-IF. + * + MOVE 0.5 TO X . + COMPUTE Z = ACOS(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '6-1 : Should not have raise exception' + END-IF. + IF Z NOT = 1.0471975511965977461542144610931676280 + THEN + DISPLAY '6-2 : <' Z + '> != 1.0471975511965977461542144610931676280' + END-IF. + * + GOBACK. +]) + +AT_CHECK([$COMPILE -d prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([function ASIN additionals tests]) +AT_KEYWORDS([functions ASIN]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + REPOSITORY. + FUNCTION ALL INTRINSIC. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Z PIC S9V9(37) COMP-3. + 01 X PIC S99V9(36) COMP-3. + 01 E-LOC PIC X(50) . + 01 E-LOC-PREV PIC X(50) . + 01 E-STATUS PIC X(50) . + * + PROCEDURE DIVISION. + * + * ASIN TESTS + * + MOVE 2 TO X . + COMPUTE Z = ASIN(X) + MOVE EXCEPTION-STATUS TO E-STATUS . + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-STATUS NOT = 'EC-ARGUMENT-FUNCTION' + THEN + DISPLAY '1-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE -2 TO X . + COMPUTE Z = ASIN(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC = E-LOC-PREV + THEN + DISPLAY '2-1: Should have raise exception'. + MOVE E-LOC TO E-LOC-PREV. + * + MOVE 0 TO X . + COMPUTE Z = ASIN(X) + MOVE EXCEPTION-LOCATION TO E-LOC. + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '3-1 : Should not have raise exception' + END-IF. + IF Z NOT = 0 + THEN + DISPLAY '3-2 : <' Z + '> != 0' + END-IF. + * + MOVE 1 TO X . + COMPUTE Z = ASIN(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '4-1 : Should not have raise exception' + END-IF. + IF Z NOT = 1.5707963267948966192313216916397514420 + THEN + DISPLAY '4-2 : <' Z + '> != 1.5707963267948966192313216916397514420' + END-IF. + * + MOVE -1 TO X . + COMPUTE Z = ASIN(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '5-1 : Should not have raise exception' + END-IF. + IF Z NOT = -1.5707963267948966192313216916397514420 + THEN + DISPLAY '5-2 : <' Z + '> != -1.5707963267948966192313216916397514420' + END-IF. + * + MOVE 0.5 TO X . + COMPUTE Z = ASIN(X) + IF E-LOC NOT = E-LOC-PREV + THEN + DISPLAY '6-1 : Should not have raise exception' + END-IF. + IF Z NOT = 0.5235987755982988730771072305465838140 + THEN + DISPLAY '6-2 : <' Z + '> != 0.5235987755982988730771072305465838140' + END-IF. + * + GOBACK. + +]) + +AT_CHECK([$COMPILE -d prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP +