From: Robert Dubner <[email protected]>
Date: Sat, 1 Aug 2026 11:50:49 -0400
Subject: [PATCH] cobol: For fixed-point arithmetic, use struct int128 with
::rdigits member.
The "struct int128" with the ::rdigits member makes for cleaner code
when implementing fixed-point arithmetic.
gcc/cobol/ChangeLog:
* compare.cc (numeric_compare): Change comment.
* genutil.cc (get_power_of_ten): Likewise.
libgcobol/ChangeLog:
* gmath.cc (get_int256_from_qualified_field): Use int128
structure.
(multiply_int128_by_int128): Likewise.
(__gg__multiplyf1_phase2): Likewise.
(__gg__multiplyf2): Likewise.
(__gg__dividef1_phase2): Likewise.
(__gg__dividef23): Likewise.
(__gg__dividef45): Likewise.
* inspect.cc (inspect_backward_format_1): Likewise.
(__gg__inspect_format_1): Likewise.
(__gg__inspect_format_1_sbc): Likewise.
* intrinsic.cc (get_value_as_double_from_qualified_field):
Likewise.
(populate_ctm_from_date): Likewise.
(populate_ctm_from_time): Likewise.
(__gg__char): Likewise.
(__gg__char_national): Likewise.
(__gg__combined_datetime): Likewise.
(__gg__date_of_integer): Likewise.
(__gg__date_to_yyyymmdd): Likewise.
(__gg__day_of_integer): Likewise.
(__gg__day_to_yyyyddd): Likewise.
(__gg__factorial): Likewise.
(__gg__integer_of_date): Likewise.
(__gg__integer_of_day): Likewise.
(__gg__random): Likewise.
(__gg__test_date_yyyymmdd): Likewise.
(__gg__test_day_yyyyddd): Likewise.
(__gg__year_to_yyyy): Likewise.
(__gg__locale_time_from_seconds): Likewise.
* libgcobol.cc (__gg__power_of_ten): Change comment.
(__gg__move): Use int128 structure.
(__gg__string): Likewise.
(__gg__binary_value_from_qualified_field): Likewise.
(__gg__int128_from_qualified_field): Likewise.
(__gg__float128_from_qualified_field): Likewise.
(__gg__unstring): Likewise.
* libgcobol.h (struct cbl_timespec): Add "struct int128"
(__gg__binary_value_from_qualified_field): Use int128 structure.
(__gg__int128_from_qualified_field): Use int128 structure.
* stringbin.cc (packed_from_combined): Change comment.
---
gcc/cobol/compare.cc | 2 +-
gcc/cobol/genutil.cc | 2 +-
libgcobol/gmath.cc | 209 +++++++++++++++++++----------------------
libgcobol/inspect.cc | 57 ++++++-----
libgcobol/intrinsic.cc | 180 +++++++++++++++--------------------
libgcobol/libgcobol.cc | 142 +++++++++++++++-------------
libgcobol/libgcobol.h | 17 +++-
libgcobol/stringbin.cc | 2 +-
8 files changed, 292 insertions(+), 319 deletions(-)
diff --git a/gcc/cobol/compare.cc b/gcc/cobol/compare.cc
index 8b612d545da..0b7c301cc85 100644
--- a/gcc/cobol/compare.cc
+++ b/gcc/cobol/compare.cc
@@ -389,7 +389,7 @@ numeric_compare(tree &left,
So consider comparing a 32.0 to a 1.9. To normalize them, I would
have to
multiply the 32.0 by 10^9, which would mean I would be comparing a
32.9 to a 1.9 . This is mathematically correct; the problem is that
an
- int128 can hold only only 38 digits, and thus can't handle the 41
digits
+ __int128 can hold only only 38 digits, and thus can't handle the 41
digits
of a 32.9.
So, in this routine I make sure the two values can be normalized
into no
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index bb6172f3db3..c8aa72ea99d 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -1036,7 +1036,7 @@ get_power_of_ten(int n)
};
if( n < 0 || n>MAX_POWER*2) // The most we can handle is 10**38
{
- fprintf(stderr, "Trying to raise 10 to %d as an int128, which we
can't do.\n", n);
+ fprintf(stderr, "Trying to raise 10 to %d as an __int128, which we
can't do.\n", n);
fprintf(stderr, "The problem is in %s.\n", __func__);
abort();
}
diff --git a/libgcobol/gmath.cc b/libgcobol/gmath.cc
index e136494948b..c4670ff10b0 100644
--- a/libgcobol/gmath.cc
+++ b/libgcobol/gmath.cc
@@ -598,12 +598,14 @@ get_int256_from_qualified_field(int256 &var,
size_t field_o,
size_t field_s)
{
- __int128 incoming =
__gg__binary_value_from_qualified_field(&var.rdigits,
- field,
- field_o,
- field_s);
- int256_set_u128(var, 0, static_cast<uint128>(incoming));
- if( incoming < 0 )
+ int128 incoming;
+ __gg__int128_from_qualified_field(incoming,
+ field,
+ field_o,
+ field_s);
+ var.rdigits = incoming.rdigits;
+ int256_set_u128(var, 0, static_cast<uint128>(incoming.i128));
+ if( incoming.i128 < 0 )
{
// This value is negative, so extend the sign bit:
var.i64[2] = UINT64_MAX;
@@ -1232,8 +1234,7 @@ __gg__subtractf3( cbl_arith_format_t ,
static bool multiply_intermediate_is_float;
static GCOB_FP128 multiply_intermediate_float;
-static __int128 multiply_intermediate_int128;
-static int multiply_intermediate_rdigits;
+static int128 multiply_intermediate_int128;
extern "C"
void
@@ -1262,23 +1263,22 @@ __gg__multiplyf1_phase1(cbl_arith_format_t ,
else
{
multiply_intermediate_is_float = false;
- multiply_intermediate_int128 =
-
__gg__binary_value_from_qualified_field(&multiply_intermediate_rdigits,
- A[0].field,
- A[0].offset,
- A[0].size);
+ __gg__int128_from_qualified_field(multiply_intermediate_int128,
+ A[0].field,
+ A[0].offset,
+ A[0].size);
}
}
static
void multiply_int128_by_int128(int256 &ABCD,
- __int128 ab_value,
- __int128 cd_value)
+ const int128 &ab_value,
+ const int128 &cd_value)
{
- bool is_negative = (ab_value < 0) != (cd_value < 0);
+ bool is_negative = (ab_value.i128 < 0) != (cd_value.i128 < 0);
- uint128 abs_ab = int128_abs_as_uint128(ab_value);
- uint128 abs_cd = int128_abs_as_uint128(cd_value);
+ uint128 abs_ab = int128_abs_as_uint128(ab_value.i128);
+ uint128 abs_cd = int128_abs_as_uint128(cd_value.i128);
uint128 AC00;
uint128 AD0;
@@ -1319,11 +1319,13 @@ void multiply_int128_by_int128(int256 &ABCD,
temp.i64[3] = uint128_hi64(AC00);
add_int256_to_int256(ABCD, temp);
- // ABCD is now a 256-bit integer with rdigits decimal places
+ // ABCD is now a 256-bit integer
if( is_negative )
{
negate_int256(ABCD);
}
+ ABCD.rdigits = ab_value.rdigits + cd_value.rdigits;
+
}
extern "C"
@@ -1370,10 +1372,11 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
if( C[0].field->type == FldFloat )
{
// fixed * float
- a_value = (GCOB_FP128) multiply_intermediate_int128;
- if( multiply_intermediate_rdigits )
+ a_value = (GCOB_FP128) multiply_intermediate_int128.i128;
+ if( multiply_intermediate_int128.rdigits )
{
- a_value /=
(GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
+ a_value /=
+
(GCOB_FP128)__gg__power_of_ten(multiply_intermediate_int128.rdigits);
}
b_value = __gg__float128_from_qualified_field(C[0].field,
C[0].offset,
@@ -1387,19 +1390,17 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
// We have two 128-bit numbers. Call them AB and CD, where A, B,
C, D are
// 64-bit "digits". We need to multiply them to create a 256-bit
result
- int cd_rdigits;
- __int128 ab_value = multiply_intermediate_int128;
- __int128 cd_value =
__gg__binary_value_from_qualified_field(&cd_rdigits,
-
C[0].field,
-
C[0].offset,
-
C[0].size);
+ int128 ab_value = multiply_intermediate_int128;
- int rdigits = multiply_intermediate_rdigits + cd_rdigits;
+ int128 cd_value;
+ __gg__int128_from_qualified_field(cd_value,
+ C[0].field,
+ C[0].offset,
+ C[0].size);
int256 ABCD;
multiply_int128_by_int128(ABCD, ab_value, cd_value);
- ABCD.rdigits = rdigits;
int overflow = squeeze_int256(ABCD);
if( overflow )
{
@@ -1409,7 +1410,7 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
*compute_error |= conditional_stash(C[0].field, C[0].offset,
C[0].size,
on_size_error,
int256_get_u128(ABCD, 0),
- rdigits,
+ ABCD.rdigits,
*rounded++);
goto done;
@@ -1467,18 +1468,17 @@ __gg__multiplyf2( cbl_arith_format_t ,
}
else
{
- int a_rdigits;
- int b_rdigits;
- __int128 a_value =
__gg__binary_value_from_qualified_field(&a_rdigits,
-
A[0].field,
-
A[0].offset,
-
A[0].size);
- __int128 b_value =
__gg__binary_value_from_qualified_field(&b_rdigits,
-
B[0].field,
-
B[0].offset,
-
B[0].size);
+ int128 a_value;
+ int128 b_value;
+ __gg__int128_from_qualified_field(a_value,
+ A[0].field,
+ A[0].offset,
+ A[0].size);
+ __gg__int128_from_qualified_field(b_value,
+ B[0].field,
+ B[0].offset,
+ B[0].size);
multiply_int128_by_int128(product_fix, a_value, b_value);
- product_fix.rdigits = a_rdigits + b_rdigits;
int overflow = squeeze_int256(product_fix);
if( overflow )
{
@@ -1798,12 +1798,12 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
{
if( C[0].field->type == FldFloat )
{
- // gixed * float
- a_value = (GCOB_FP128) multiply_intermediate_int128;
- if( multiply_intermediate_rdigits )
+ // fixed by float
+ a_value = (GCOB_FP128) multiply_intermediate_int128.i128;
+ if( multiply_intermediate_int128.rdigits )
{
a_value /=
-
(GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
+
(GCOB_FP128)__gg__power_of_ten(multiply_intermediate_int128.rdigits);
}
b_value = __gg__float128_from_qualified_field(C[0].field,
C[0].offset,
@@ -1812,26 +1812,20 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
}
else
{
- // fixed times fixed
-
- // We have two 128-bit numbers. Call them AB and CD, where A, B,
C, D
- // are 64-bit "digits". We need to multiply them to create a
256-bit
- // result
-
- int dividend_rdigits;
- __int128 dividend = __gg__binary_value_from_qualified_field(
- ÷nd_rdigits,
- C[0].field,
- C[0].offset,
- C[0].size);
+ // fixed by fixed
+ int128 dividend;
+ __gg__int128_from_qualified_field(dividend,
+ C[0].field,
+ C[0].offset,
+ C[0].size);
int256 quotient;
divide_int128_by_int128(quotient,
- dividend,
- dividend_rdigits,
- multiply_intermediate_int128,
- multiply_intermediate_rdigits,
+ dividend.i128,
+ dividend.rdigits,
+ multiply_intermediate_int128.i128,
+ multiply_intermediate_int128.rdigits,
compute_error);
int overflow = squeeze_int256(quotient);
@@ -1914,26 +1908,24 @@ __gg__dividef23(cbl_arith_format_t ,
else
{
// fixed divided by fixed
- int dividend_rdigits;
- __int128 dividend = __gg__binary_value_from_qualified_field(
- ÷nd_rdigits,
- A[0].field,
- A[0].offset,
- A[0].size);
-
- int divisor_rdigits;
- __int128 divisor = __gg__binary_value_from_qualified_field(
- &divisor_rdigits,
- B[0].field,
- B[0].offset,
- B[0].size);
+ int128 dividend;
+ __gg__int128_from_qualified_field(dividend,
+ A[0].field,
+ A[0].offset,
+ A[0].size);
+
+ int128 divisor;
+ __gg__int128_from_qualified_field(divisor,
+ B[0].field,
+ B[0].offset,
+ B[0].size);
int256 quotient;
divide_int128_by_int128(quotient,
- dividend,
- dividend_rdigits,
- divisor,
- divisor_rdigits,
+ dividend.i128,
+ dividend.rdigits,
+ divisor.i128,
+ divisor.rdigits,
compute_error);
@@ -2006,27 +1998,24 @@ __gg__dividef45(cbl_arith_format_t ,
else
{
// fixed divided by fixed
- int dividend_rdigits;
- __int128 dividend = __gg__binary_value_from_qualified_field(
- ÷nd_rdigits,
- A[0].field,
- A[0].offset,
- A[0].size);
-
- int divisor_rdigits;
- __int128 divisor = __gg__binary_value_from_qualified_field(
- &divisor_rdigits,
- B[0].field,
- B[0].offset,
- B[0].size);
+ int128 dividend;
+ __gg__int128_from_qualified_field(dividend,
+ A[0].field,
+ A[0].offset,
+ A[0].size);
+ int128 divisor;
+ __gg__int128_from_qualified_field(divisor,
+ B[0].field,
+ B[0].offset,
+ B[0].size);
int256 quotient;
divide_int128_by_int128(quotient,
- dividend,
- dividend_rdigits,
- divisor,
- divisor_rdigits,
+ dividend.i128,
+ dividend.rdigits,
+ divisor.i128,
+ divisor.rdigits,
compute_error);
*compute_error |= squeeze_int256(quotient);
@@ -2034,8 +2023,7 @@ __gg__dividef45(cbl_arith_format_t ,
if( !*compute_error )
{
// We are going to need the unrounded quotient to calculate the
remainder
- __int128 unrounded_quotient = 0;
- int unrounded_quotient_digits;
+ int128 unrounded_quotient;
rounded_p += 1;// Skip the rounded value for the remainder
cbl_round_t rounded = *rounded_p;
switch(rounded)
@@ -2049,11 +2037,10 @@ __gg__dividef45(cbl_arith_format_t ,
int256_get_u128(quotient,
0),
quotient.rdigits,
*rounded_p++);
- unrounded_quotient = __gg__binary_value_from_qualified_field(
-
&unrounded_quotient_digits,
- C[1].field,
- C[1].offset,
- C[1].size);
+ __gg__int128_from_qualified_field(unrounded_quotient,
+ C[1].field,
+ C[1].offset,
+ C[1].size);
break;
}
default:
@@ -2063,11 +2050,10 @@ __gg__dividef45(cbl_arith_format_t ,
int256_get_u128(quotient, 0),
quotient.rdigits,
truncation_e);
- unrounded_quotient = __gg__binary_value_from_qualified_field(
-
&unrounded_quotient_digits,
- C[1].field,
- C[1].offset,
- C[1].size);
+ __gg__int128_from_qualified_field(unrounded_quotient,
+ C[1].field,
+ C[1].offset,
+ C[1].size);
// At this point, we assign the rounded quotient to *C.
*compute_error |= conditional_stash(C[1].field,
C[1].offset,
@@ -2100,12 +2086,11 @@ __gg__dividef45(cbl_arith_format_t ,
int256 temp;
// Step 1: Multiply the unrounded quotient by the divisor
multiply_int128_by_int128(temp, unrounded_quotient, divisor);
- temp.rdigits = unrounded_quotient_digits + divisor_rdigits;
int256 odividend = {};
- int256_set_u128(odividend, 0, static_cast<uint128>(dividend));
- odividend.rdigits = dividend_rdigits;
- if( dividend < 0 )
+ int256_set_u128(odividend, 0,
static_cast<uint128>(dividend.i128));
+ odividend.rdigits = dividend.rdigits;
+ if( dividend.i128 < 0 )
{
odividend.i64[2] = UINT64_MAX;
odividend.i64[3] = UINT64_MAX;
diff --git a/libgcobol/inspect.cc b/libgcobol/inspect.cc
index 373eb5068c5..7c140cf692a 100644
--- a/libgcobol/inspect.cc
+++ b/libgcobol/inspect.cc
@@ -1161,25 +1161,24 @@ inspect_backward_format_1(const size_t integers[],
for(size_t i = 0; i<id_2_results.size(); i++)
{
- int rdigits;
- __int128 id_2_value
- = __gg__binary_value_from_qualified_field(&rdigits,
- id_2_results[i].id2,
- id_2_results[i].id2_o,
- id_2_results[i].id2_s);
- while(rdigits--)
+ int128 id_2_value;
+ __gg__int128_from_qualified_field(id_2_value,
+ id_2_results[i].id2,
+ id_2_results[i].id2_o,
+ id_2_results[i].id2_s);
+ while(id_2_value.rdigits--)
{
- id_2_value /= 10.0;
+ id_2_value.i128 /= 10.0;
}
// Accumulate what we've found into it
- id_2_value += id_2_results[i].result;
+ id_2_value.i128 += id_2_results[i].result;
// And put it back:
__gg__int128_to_qualified_field(id_2_results[i].id2,
id_2_results[i].id2_o,
id_2_results[i].id2_s,
- id_2_value,
+ id_2_value.i128,
0,
truncation_e,
NULL);
@@ -1531,25 +1530,24 @@ __gg__inspect_format_1( int backward,
for(size_t i = 0; i<id_2_results.size(); i++)
{
- int rdigits;
- __int128 id_2_value
- = __gg__binary_value_from_qualified_field(&rdigits,
- id_2_results[i].id2,
- id_2_results[i].id2_o,
- id_2_results[i].id2_s);
- while(rdigits--)
+ int128 id_2_value;
+ __gg__int128_from_qualified_field(id_2_value,
+ id_2_results[i].id2,
+ id_2_results[i].id2_o,
+ id_2_results[i].id2_s);
+ while(id_2_value.rdigits--)
{
- id_2_value /= 10.0;
+ id_2_value.i128 /= 10.0;
}
// Accumulate what we've found into it
- id_2_value += id_2_results[i].result;
+ id_2_value.i128 += id_2_results[i].result;
// And put it back:
__gg__int128_to_qualified_field(id_2_results[i].id2,
id_2_results[i].id2_o,
id_2_results[i].id2_s,
- id_2_value,
+ id_2_value.i128,
0,
truncation_e,
NULL);
@@ -2994,25 +2992,24 @@ __gg__inspect_format_1_sbc( int backward,
for(size_t i = 0; i<id_2_results.size(); i++)
{
- int rdigits;
- __int128 id_2_value
- = __gg__binary_value_from_qualified_field(&rdigits,
- id_2_results[i].id2,
- id_2_results[i].id2_o,
- id_2_results[i].id2_s);
- while(rdigits--)
+ int128 id_2_value;
+ __gg__int128_from_qualified_field(id_2_value,
+ id_2_results[i].id2,
+ id_2_results[i].id2_o,
+ id_2_results[i].id2_s);
+ while(id_2_value.rdigits--)
{
- id_2_value /= 10.0;
+ id_2_value.i128 /= 10.0;
}
// Accumulate what we've found into it
- id_2_value += id_2_results[i].result;
+ id_2_value.i128 += id_2_results[i].result;
// And put it back:
__gg__int128_to_qualified_field(id_2_results[i].id2,
id_2_results[i].id2_o,
id_2_results[i].id2_s,
- id_2_value,
+ id_2_value.i128,
0,
truncation_e,
NULL);
diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc
index b56e828fb2b..de139b2b59d 100644
--- a/libgcobol/intrinsic.cc
+++ b/libgcobol/intrinsic.cc
@@ -447,7 +447,7 @@ get_value_as_double_from_qualified_field( const
cblc_field_t *input,
size_t input_s)
{
double retval;
- int rdigits;
+ int128 val128;
switch( input->type )
{
@@ -458,11 +458,11 @@ get_value_as_double_from_qualified_field( const
cblc_field_t *input,
break;
default:
- retval = __gg__binary_value_from_qualified_field(&rdigits,
- input,
- input_o,
- input_s);
- for(int i=0; i<rdigits; i++)
+ retval = __gg__int128_from_qualified_field(val128,
+ input,
+ input_o,
+ input_s);
+ for(int i=0; i<val128.rdigits; i++)
{
retval /= 10.0;
}
@@ -757,11 +757,9 @@ populate_ctm_from_date( struct cobol_tm &ctm,
size_t pdate_size)
{
// Get the date as an integer
- int rdigits;
- double JD = (double)__gg__binary_value_from_qualified_field(&rdigits,
- pdate,
-
pdate_offset,
-
pdate_size);
+ double JD = (double)__gg__int128_from_qualified_field(pdate,
+ pdate_offset,
+ pdate_size);
populate_ctm_from_JD(ctm, JD);
}
@@ -800,15 +798,14 @@ populate_ctm_from_time( struct cobol_tm &ctm,
if( poffset )
{
- int rdigits;
- int value = (int)__gg__binary_value_from_qualified_field(&rdigits,
- poffset,
- poffset_o,
- poffset_s);
- if( rdigits )
+ int128 val128;
+ int value = (int)__gg__int128_from_qualified_field(val128,
+ poffset,
+ poffset_o,
+ poffset_s);
+ if( val128.rdigits )
{
- value /= __gg__power_of_ten(rdigits);
- rdigits = 0;
+ value /= __gg__power_of_ten(val128.rdigits);
}
ctm.tz_offset = value;
if( abs(value) >= 1440 )
@@ -1210,8 +1207,6 @@ __gg__char( cblc_field_t *dest,
size_t source_offset,
size_t source_size)
{
- int rdigits;
-
// The CHAR function takes an integer, the ordinal position. It
// returns a single-character string, which is the character at that
// ordinal position in the DISPLAY collation.
@@ -1219,11 +1214,12 @@ __gg__char( cblc_field_t *dest,
// 'A', with the ascii value of 65, is at the ordinal position 66
// in the default collation.
- int ordinal = (int)(__gg__binary_value_from_qualified_field(&rdigits,
- source,
-
source_offset,
-
source_size));
- ordinal /= __gg__power_of_ten(rdigits);
+ int128 val128;
+ int ordinal = (int)(__gg__int128_from_qualified_field(val128,
+ source,
+ source_offset,
+ source_size));
+ ordinal /= __gg__power_of_ten(val128.rdigits);
ordinal -= 1;
// We now look for that ordinal position in the collation table:
@@ -1301,7 +1297,6 @@ __gg__char_national(cblc_field_t *dest,
// Since we haven't tried to implement collation sequences for
National,
// this whole subroutine is a Hail Mary play. I frankly don't even
know
// why we tried.
- int rdigits;
// The CHAR function takes an integer, the ordinal position. It
// returns a single-character string, which is the character at that
@@ -1310,11 +1305,12 @@ __gg__char_national(cblc_field_t *dest,
// 'A', with the ascii value of 65, is at the ordinal position 66
// in the default collation.
- int ordinal = (int)(__gg__binary_value_from_qualified_field(&rdigits,
- source,
-
source_offset,
-
source_size));
- ordinal /= __gg__power_of_ten(rdigits);
+ int128 val128;
+ int ordinal = (int)(__gg__int128_from_qualified_field(val128,
+ source,
+ source_offset,
+ source_size));
+ ordinal /= __gg__power_of_ten(val128.rdigits);
ordinal -= 1;
// We need to convert the ch character to the destination encoding.
@@ -1335,16 +1331,12 @@ __gg__combined_datetime(cblc_field_t *dest,
size_t arg2_offset,
size_t arg2_size)
{
- int rdigits;
-
- __int128 val1 = (int)(__gg__binary_value_from_qualified_field(&rdigits,
- arg1,
-
arg1_offset,
-
arg1_size));
- __int128 val2 = (int)(__gg__binary_value_from_qualified_field(&rdigits,
- arg2,
-
arg2_offset,
-
arg2_size));
+ __int128 val1 = (int)(__gg__int128_from_qualified_field(arg1,
+ arg1_offset,
+ arg1_size));
+ __int128 val2 = (int)(__gg__int128_from_qualified_field(arg2,
+ arg2_offset,
+ arg2_size));
__int128 value = val1 * 1000000 + val2;
__gg__int128_to_field(dest,
value,
@@ -1450,11 +1442,9 @@ __gg__date_of_integer(cblc_field_t *dest,
size_t source_size)
{
// FUNCTION DATE-OF-INTEGER
- int rdigits;
- double JD = (double)__gg__binary_value_from_qualified_field(&rdigits,
- source,
-
source_offset,
-
source_size);
+ double JD = (double)__gg__int128_from_qualified_field(source,
+ source_offset,
+ source_size);
JD += JD_OF_1601_01_02;
int Y;
int M;
@@ -1483,10 +1473,9 @@ __gg__date_to_yyyymmdd( cblc_field_t *dest,
{
// FUNCTION DATE-TO-YYYYMMDD
// See the discussion in ISO/IEC 2014-1989 Section 15.20
- int rdigits;
- int arg1 = (int)__gg__binary_value_from_qualified_field(&rdigits, par1,
par1_o, par1_s);
- int arg2 = (int)__gg__binary_value_from_qualified_field(&rdigits, par2,
par2_o, par2_s );
- int arg3 = (int)__gg__binary_value_from_qualified_field(&rdigits, par3,
par3_o, par3_s);
+ int arg1 = (int)__gg__int128_from_qualified_field(par1, par1_o,
par1_s);
+ int arg2 = (int)__gg__int128_from_qualified_field(par2, par2_o, par2_s
);
+ int arg3 = (int)__gg__int128_from_qualified_field(par3, par3_o,
par3_s);
int yy = arg1/10000;
int mmdd = arg1%10000;
@@ -1507,11 +1496,9 @@ __gg__day_of_integer( cblc_field_t *dest,
size_t source_size)
{
// FUNCTION DAY-OF_INTEGER
- int rdigits;
- double JD = (double)__gg__binary_value_from_qualified_field(&rdigits,
- source,
-
source_offset,
-
source_size);
+ double JD = (double)__gg__int128_from_qualified_field(source,
+ source_offset,
+ source_size);
JD += JD_OF_1601_01_02;
int Y;
int M;
@@ -1543,10 +1530,9 @@ __gg__day_to_yyyyddd( cblc_field_t *dest,
{
// FUNCTION DAY-TO-YYYYDDD
// See the discussion in ISO/IEC 2014-1989 Section 15.20
- int rdigits;
- int arg1 = (int)__gg__binary_value_from_qualified_field(&rdigits, par1,
par1_o, par1_s);
- int arg2 = (int)__gg__binary_value_from_qualified_field(&rdigits, par2,
par2_o, par2_s );
- int arg3 = (int)__gg__binary_value_from_qualified_field(&rdigits, par3,
par3_o, par3_s);
+ int arg1 = (int)__gg__int128_from_qualified_field(par1, par1_o,
par1_s);
+ int arg2 = (int)__gg__int128_from_qualified_field(par2, par2_o, par2_s
);
+ int arg3 = (int)__gg__int128_from_qualified_field(par3, par3_o,
par3_s);
int yy = arg1/1000;
int ddd = arg1%1000;
@@ -1619,12 +1605,12 @@ __gg__factorial(cblc_field_t *dest,
size_t source_size)
{
// FUNCTION FACTORIAL
- int rdigits;
- int N = (int)__gg__binary_value_from_qualified_field( &rdigits,
- source,
- source_offset,
- source_size);
- while(rdigits--)
+ int128 val128;
+ int N = (int)__gg__int128_from_qualified_field(val128,
+ source,
+ source_offset,
+ source_size);
+ while(val128.rdigits--)
{
N /= 10;
}
@@ -1918,11 +1904,9 @@ __gg__integer_of_date(cblc_field_t *dest,
size_t source_size)
{
// FUNCTION INTEGER-OF-DATE
- int rdigits;
- long argument_1 =
(long)(__gg__binary_value_from_qualified_field(&rdigits,
- source,
-
source_offset,
-
source_size));
+ long argument_1 = (long)(__gg__int128_from_qualified_field(source,
+
source_offset,
+
source_size));
int retval = 0;
static const int max_days[13] = {0, 31, 28, 31, 30, 31, 30,
@@ -1974,11 +1958,9 @@ __gg__integer_of_day( cblc_field_t *dest,
{
// FUNCTION INTEGER-OF-DAY
// Convert YYYYDDD to "integer date"
- int rdigits;
- int yyyyddd = (int)__gg__binary_value_from_qualified_field( &rdigits,
- source,
-
source_offset,
-
source_size);
+ int yyyyddd = (int)__gg__int128_from_qualified_field(source,
+ source_offset,
+ source_size);
int yyyy = yyyyddd / 1000;
int ddd = yyyyddd % 1000;
@@ -3776,7 +3758,6 @@ __gg__random( cblc_field_t *dest,
size_t input_size)
{
int32_t retval_31;
- int rdigits;
#if HAVE_INITSTATE_R && HAVE_SRANDOM_R && HAVE_RANDOM_R
// This creates a thread-safe pseudo-random number generator
// using input as the seed
@@ -3794,18 +3775,16 @@ __gg__random( cblc_field_t *dest,
__gg__clock_gettime(&ts);
initstate_r( ts.tv_nsec, state, state_len, buf);
}
- int seed = (int)__gg__binary_value_from_qualified_field(&rdigits,
- input,
- input_offset,
- input_size);
+ int seed = (int)__gg__int128_from_qualified_field(input,
+ input_offset,
+ input_size);
srandom_r(seed, buf);
random_r(buf, &retval_31);
#else
- seed = (unsigned)__gg__binary_value_from_qualified_field(&rdigits,
- input,
- input_offset,
- input_size);
+ seed = (unsigned)__gg__int128_from_qualified_field(input,
+ input_offset,
+ input_size);
srandom (seed);
retval_31 = random ();
#endif
@@ -4022,11 +4001,9 @@ __gg__test_date_yyyymmdd( cblc_field_t *dest,
size_t source_offset,
size_t source_size)
{
- int rdigits;
- int yyyymmdd = (int)__gg__binary_value_from_qualified_field(&rdigits,
- source,
-
source_offset,
-
source_size);
+ int yyyymmdd = (int)__gg__int128_from_qualified_field(source,
+ source_offset,
+ source_size);
int retval;
int mmdd = yyyymmdd % 10000;
int mm = mmdd / 100;
@@ -4075,11 +4052,9 @@ __gg__test_day_yyyyddd( cblc_field_t *dest,
size_t source_offset,
size_t source_size)
{
- int rdigits;
- int yyyyddd = (int)__gg__binary_value_from_qualified_field(&rdigits,
- source,
-
source_offset,
-
source_size);
+ int yyyyddd = (int)__gg__int128_from_qualified_field(source,
+ source_offset,
+ source_size);
int retval;
int ddd = yyyyddd % 1000;
int yyyy = yyyyddd / 1000;
@@ -4164,10 +4139,9 @@ __gg__year_to_yyyy( cblc_field_t *dest,
size_t par3_s)
{
// FUNCTION YEAR_TO_YYYY
- int rdigits;
- int yy = (int)__gg__binary_value_from_qualified_field(&rdigits, par1,
par1_o, par1_s);
- int arg2 = (int)__gg__binary_value_from_qualified_field(&rdigits, par2,
par2_o, par2_s );
- int arg3 = (int)__gg__binary_value_from_qualified_field(&rdigits, par3,
par3_o, par3_s);
+ int yy = (int)__gg__int128_from_qualified_field(par1, par1_o,
par1_s);
+ int arg2 = (int)__gg__int128_from_qualified_field(par2, par2_o, par2_s
);
+ int arg3 = (int)__gg__int128_from_qualified_field(par3, par3_o,
par3_s);
int retval = year_to_yyyy(yy, arg2, arg3);
@@ -6021,11 +5995,9 @@ __gg__locale_time_from_seconds( cblc_field_t *dest,
// Default locale
tm tm = {};
- int rdigits=0;
- long seconds =
(long)__gg__binary_value_from_qualified_field(&rdigits,
- arg1,
- arg1_o,
- arg1_s);
+ long seconds = (long)__gg__int128_from_qualified_field(arg1,
+ arg1_o,
+ arg1_s);
tm.tm_hour = seconds/3600;
tm.tm_min = ((seconds%3600) / 60) % 100;
tm.tm_sec = seconds % 100;
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index ba421cee2cf..70f4fdfa619 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -1350,7 +1350,7 @@ __gg__power_of_ten(int n)
if( n < 0 || n>MAX_POWER*2) // The most we can handle is 10**38
{
fprintf(stderr,
- "Trying to raise 10 to %d as an int128, which we can't
do.\n",
+ "Trying to raise 10 to %d as an __int128, which we can't
do.\n",
n);
fprintf(stderr,
"The problem is in %s %s:%d.\n",
@@ -6422,7 +6422,6 @@ __gg__move( cblc_field_t *fdest,
int size_error = 0; // This is the return value
__int128 value;
- int rdigits;
charmap_t *charmap = __gg__get_charmap(fdest->encoding);
int stride = charmap->stride();
@@ -6598,10 +6597,9 @@ __gg__move( cblc_field_t *fdest,
? -fsource->rdigits : 0) ;
// Pick up the absolute value of the source
- value = __gg__binary_value_from_qualified_field(&rdigits,
- fsource,
-
source_offset,
-
source_size);
+ value = __gg__int128_from_qualified_field(fsource,
+ source_offset,
+ source_size);
char ach[128];
@@ -6676,10 +6674,9 @@ __gg__move( cblc_field_t *fdest,
char ach[128];
// Turn the integer source into a value:
- value = __gg__binary_value_from_qualified_field(&rdigits,
- fsource,
-
source_offset,
-
source_size);
+ value = __gg__int128_from_qualified_field(fsource,
+ source_offset,
+ source_size);
source_size = fsource->digits;
@@ -6793,10 +6790,9 @@ __gg__move( cblc_field_t *fdest,
char ach[128];
// Turn the integer source into a value:
- value = __gg__binary_value_from_qualified_field(&rdigits,
- fsource,
-
source_offset,
- source_size);
+ value = __gg__int128_from_qualified_field(fsource,
+ source_offset,
+ source_size);
// Turn the integer value into a string:
__gg__binary_to_string_encoded(ach,
source_size,
@@ -6881,36 +6877,37 @@ __gg__move( cblc_field_t *fdest,
case FldLiteralN:
{
// We are moving a number to a number:
- value = __gg__binary_value_from_qualified_field(&rdigits,
- fsource,
-
source_offset,
- source_size);
+ int128 val128;
+ __gg__int128_from_qualified_field(val128,
+ fsource,
+ source_offset,
+ source_size);
if( truncation_mode == trunc_std_e )
{
// We need to adjust the value to have the rdigits of the
// the destination:
- int scaler = rdigits - fdest->rdigits;
+ int scaler = val128.rdigits - fdest->rdigits;
if( scaler > 0 )
{
- value /= __gg__power_of_ten(scaler);
- rdigits -= scaler;
+ val128.i128 /= __gg__power_of_ten(scaler);
+ val128.rdigits -= scaler;
}
else if( scaler < 0 )
{
- value *= __gg__power_of_ten(-scaler);
- rdigits -= scaler;
+ val128.i128 *= __gg__power_of_ten(-scaler);
+ val128.rdigits -= scaler;
}
- if( value < 0 )
+ if( val128.i128 < 0 )
{
- value = -value;
- value %= __gg__power_of_ten(fdest->digits);
- value = -value;
+ val128.i128 = -val128.i128;
+ val128.i128 %= __gg__power_of_ten(fdest->digits);
+ val128.i128 = -val128.i128;
}
else
{
- value %= __gg__power_of_ten(fdest->digits);
+ val128.i128 %= __gg__power_of_ten(fdest->digits);
}
}
@@ -6918,8 +6915,8 @@ __gg__move( cblc_field_t *fdest,
fdest,
dest_offset,
dest_size,
- value,
- rdigits,
+ val128.i128,
+ val128.rdigits,
rounded,
&size_error );
break;
@@ -6927,7 +6924,7 @@ __gg__move( cblc_field_t *fdest,
case FldFloat:
{
- rdigits = get_scaled_rdigits(fdest);
+ int rdigits = get_scaled_rdigits(fdest);
bool negative = false;
__int128 value128 = 0;
switch(fsource->capacity)
@@ -7032,15 +7029,16 @@ __gg__move( cblc_field_t *fdest,
case FldLiteralN:
{
// We are moving a number to a number:
- value = __gg__binary_value_from_qualified_field(&rdigits,
- fsource,
-
source_offset,
- source_size);
+ int128 val128;
+ __gg__int128_from_qualified_field(val128,
+ fsource,
+ source_offset,
+ source_size);
__gg__int128_to_qualified_field( fdest,
dest_offset,
dest_size,
- value,
- rdigits,
+ val128.i128,
+ val128.rdigits,
rounded,
&size_error );
break;
@@ -7050,7 +7048,6 @@ __gg__move( cblc_field_t *fdest,
{
// We are converted a floating-point value fixed-point
- rdigits = get_scaled_rdigits(fdest);
GCOB_FP128 fp128=0;
switch(fsource->capacity)
{
@@ -7112,10 +7109,9 @@ __gg__move( cblc_field_t *fdest,
+ (fsource->rdigits<0 ? -fsource->rdigits :
0) ;
// Pick up the absolute value of the source
- value = __gg__binary_value_from_qualified_field(&rdigits,
- fsource,
-
source_offset,
- source_size);
+ value = __gg__int128_from_qualified_field(fsource,
+ source_offset,
+ source_size);
char ach[64];
// Convert it to the full complement of digits available
@@ -8048,9 +8044,7 @@ __gg__string(const size_t integers[], const
cblc_referlet_t *ref)
int overflow = 0;
if( ref[INDEX_OF_POINTER].field )
{
- int rdigits;
- int p = (size_t)__gg__binary_value_from_qualified_field(
- &rdigits,
+ int p = (size_t)__gg__int128_from_qualified_field(
ref[INDEX_OF_POINTER]
.field,
ref[INDEX_OF_POINTER]
@@ -8603,19 +8597,39 @@ __gg__binary_value_from_field( int *rdigits,
var->capacity);
}
-extern "C"
__int128
-__gg__binary_value_from_qualified_field(int *rdigits,
- const cblc_field_t *var,
+__gg__int128_from_qualified_field(const cblc_field_t *var,
size_t offset,
size_t size)
{
- return get_binary_value_local( rdigits,
+ // Use this version when rdigits isn't relevant
+ int rdigits;
+ return get_binary_value_local( &rdigits,
var,
var->data + offset,
size);
}
+__int128
+__gg__int128_from_qualified_field(int128 &i128,
+ const cblc_field_t *var,
+ size_t offset,
+ size_t size)
+ {
+ // This routine does double-duty. It converts VAR to a fixed-point
+ // int128 that carries an rdigits value. It also returns the __int128
+ // portion of that value, because many routines that know there are no
+ // rdigits also call this routine. This is a holdover from the time
+ // before this routine was refactored to carry the rdigits, which were
+ // maintained in the external logic before int128::rdigits was
implemented/
+
+ i128.i128 = get_binary_value_local(&i128.rdigits,
+ var,
+ var->data + offset,
+ size);
+ return i128.i128;
+ }
+
extern "C"
GCOB_FP128
__gg__float128_from_field( cblc_field_t *field )
@@ -8650,14 +8664,14 @@ __gg__float128_from_qualified_field(const
cblc_field_t *field,
}
else
{
- int rdigits;
- retval =
(GCOB_FP128)__gg__binary_value_from_qualified_field(&rdigits,
- field,
- offset,
- size);
- if( rdigits )
+ int128 i128;
+ retval = (GCOB_FP128)__gg__int128_from_qualified_field(i128,
+ field,
+ offset,
+ size);
+ if( i128.rdigits )
{
- retval /= (GCOB_FP128)__gg__power_of_ten(rdigits);
+ retval /= (GCOB_FP128)__gg__power_of_ten(i128.rdigits);
}
}
return retval;
@@ -10077,20 +10091,16 @@ __gg__unstring( const cblc_referlet_t *id2,
if( id8 )
{
- int rdigits;
- tally = (int)__gg__binary_value_from_qualified_field(&rdigits,
- id8,
- id8_o,
- id8_s);
+ tally = (int)__gg__int128_from_qualified_field(id8,
+ id8_o,
+ id8_s);
}
if( id7 )
{
- int rdigits;
- int p = (int)__gg__binary_value_from_qualified_field(&rdigits,
- id7,
- id7_o,
- id7_s);
+ int p = (int)__gg__int128_from_qualified_field(id7,
+ id7_o,
+ id7_s);
if( p < 1 )
{
overflow = 1;
diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h
index 3dadfef7661..92e8c497c63 100644
--- a/libgcobol/libgcobol.h
+++ b/libgcobol/libgcobol.h
@@ -105,6 +105,12 @@ struct cbl_timespec
long tv_nsec; // Nanoseconds.
} ;
+typedef struct int128
+ {
+ __int128 i128;
+ int rdigits;
+ }int128;
+
extern "C" void __gg__clock_gettime(struct cbl_timespec *tp);
extern "C" GCOB_FP128 __gg__float128_from_location(
@@ -116,10 +122,13 @@ extern "C" void __gg__realloc_if_necessary( char
**dest,
size_t *dest_size,
size_t new_size);
extern "C" void __gg__set_exception_file(const cblc_file_t *file);
-extern "C" __int128 __gg__binary_value_from_qualified_field(int
*rdigits,
- const
cblc_field_t *var,
- size_t
offset,
- size_t
size);
+__int128 __gg__int128_from_qualified_field(const cblc_field_t *var,
+ size_t offset,
+ size_t size);
+__int128 __gg__int128_from_qualified_field(struct int128 &i128,
+ const cblc_field_t *var,
+ size_t offset,
+ size_t size);
extern "C" GCOB_FP128 __gg__float128_from_qualified_field(const
cblc_field_t *field,
size_t offset,
size_t size);
diff --git a/libgcobol/stringbin.cc b/libgcobol/stringbin.cc
index 7d480d1bb97..75e97ce965a 100644
--- a/libgcobol/stringbin.cc
+++ b/libgcobol/stringbin.cc
@@ -407,7 +407,7 @@ packed_from_combined(const COMBINED &combined)
if( combined.run > 9)
{
- // Stage 1: pull from int128 until the top half is zero.
+ // Stage 1: pull from __int128 until the top half is zero.
__int128 value128 = combined.val128;
#if COBOL_LITTLE_ENDIAN
while(value128>>64)
--
2.34.1
