Files
gcc/libgcobol/gmath.cc
Robert Dubner 54e4f75b7d cobol: Eliminate cppcheck warnings for libgcobol [PR119323]
I configured and ran cppcheck-2.17.0 with this config file:

<?xml version="1.0"?>
<def format="2">
  <define name="HOST_SIZE_T_PRINT_UNSIGNED" value="&quot;%ld&quot;"/>
  <define name="GCC_PRISZ" value="&quot;z&quot;"/>
  <define name="YYLTYPE" value="struct {int first_line; int first_column; int last_line; int last_column;}"/>
  <define name="__FLT128_MANT_DIG__" value="113"/>
  <define name="__FLT128_MIN_EXP__" value="-16381"/>
</def>

and this command line

cppcheck --inline-suppr --enable=all --force --language=c++ --library=$CFG \
--check-level=exhaustive \
--disable=unusedFunction \
--disable=missingInclude \
$(cat $FILES) > $RESULT 2>&1

$FILES was all of the .cc files in libgcobol.

The result was many hundreds of warnings.  The vast bulk of them were
recommendations for declaring variables as const, recommendations for
changing C-style casts to C++ casts, cheery notes about shadowed
variables, and complaints that malloc() results weren't being checked
for errors.

Two and a half days of applied OCD on my part has reduced the number of
warnings down to zero.

libgcobol/ChangeLog:

	PR cobol/119323
	* charmaps.cc (__gg__raw_to_ascii):  Eliminate cppcheck warnings.
	(__gg__raw_to_ebcdic): Likewise.
	(__gg__ebcdic_to_console): Likewise.
	(__gg__console_to_ascii): Likewise.
	(__gg__console_to_ebcdic): Likewise.
	* common-defs.h (struct cbl_declarative_t): Likewise.
	* gfileio.cc (get_filename): Likewise.
	(max_value): Likewise.
	(relative_file_delete_varying): Likewise.
	(relative_file_delete): Likewise.
	(read_an_indexed_record): Likewise.
	(position_state_restore): Likewise.
	(indexed_file_delete): Likewise.
	(indexed_file_start): Likewise.
	(sequential_file_rewrite): Likewise.
	(relative_file_write_varying): Likewise.
	(relative_file_write): Likewise.
	(sequential_file_write): Likewise.
	(indexed_file_write): Likewise.
	(__io__file_write): Likewise.
	(line_sequential_file_read): Likewise.
	(indexed_file_read): Likewise.
	(file_indexed_open): Likewise.
	(__gg__file_reopen): Likewise.
	* gmath.cc (conditional_stash): Likewise.
	(__gg__pow): Likewise.
	(multiply_int256_by_int64): Likewise.
	(add_int256_to_int256): Likewise.
	(divide_int256_by_int64): Likewise.
	(squeeze_int256): Likewise.
	(get_int256_from_qualified_field): Likewise.
	(__gg__add_fixed_phase1): Likewise.
	(__gg__addf1_fixed_phase2): Likewise.
	(__gg__fixed_phase2_assign_to_c): Likewise.
	(__gg__add_float_phase1): Likewise.
	(__gg__addf1_float_phase2): Likewise.
	(__gg__float_phase2_assign_to_c): Likewise.
	(__gg__addf3): Likewise.
	(__gg__subtractf1_fixed_phase2): Likewise.
	(__gg__subtractf2_fixed_phase1): Likewise.
	(__gg__subtractf1_float_phase2): Likewise.
	(__gg__subtractf2_float_phase1): Likewise.
	(__gg__subtractf3): Likewise.
	(__gg__multiplyf1_phase1): Likewise.
	(multiply_int128_by_int128): Likewise.
	(__gg__multiplyf1_phase2): Likewise.
	(__gg__multiplyf2): Likewise.
	(shift_in_place128): Likewise.
	(divide_int128_by_int128): Likewise.
	(__gg__dividef1_phase2): Likewise.
	(__gg__dividef23): Likewise.
	(__gg__dividef45): Likewise.
	* intrinsic.cc (struct input_state): Likewise.
	(get_value_as_double_from_qualified_field): Likewise.
	(kahan_summation): Likewise.
	(variance): Likewise.
	(get_all_time): Likewise.
	(populate_ctm_from_date): Likewise.
	(populate_ctm_from_time): Likewise.
	(ftime_replace): Likewise.
	(__gg__abs): Likewise.
	(__gg__acos): Likewise.
	(__gg__annuity): Likewise.
	(__gg__asin): Likewise.
	(__gg__atan): Likewise.
	(__gg__byte_length): Likewise.
	(__gg__char): Likewise.
	(__gg__combined_datetime): Likewise.
	(__gg__cos): Likewise.
	(__gg__date_of_integer): Likewise.
	(__gg__date_to_yyyymmdd): Likewise.
	(__gg__day_of_integer): Likewise.
	(__gg__day_to_yyyyddd): Likewise.
	(__gg__exp): Likewise.
	(__gg__exp10): Likewise.
	(__gg__factorial): Likewise.
	(__gg__formatted_current_date): Likewise.
	(__gg__formatted_date): Likewise.
	(__gg__formatted_datetime): Likewise.
	(__gg__formatted_time): Likewise.
	(__gg__integer): Likewise.
	(__gg__integer_of_date): Likewise.
	(__gg__integer_of_day): Likewise.
	(__gg__integer_part): Likewise.
	(__gg__fraction_part): Likewise.
	(__gg__log): Likewise.
	(__gg__log10): Likewise.
	(__gg__max): Likewise.
	(__gg__lower_case): Likewise.
	(__gg__median): Likewise.
	(__gg__min): Likewise.
	(numval): Likewise.
	(numval_c): Likewise.
	(__gg__numval): Likewise.
	(__gg__test_numval): Likewise.
	(__gg__numval_c): Likewise.
	(__gg__test_numval_c): Likewise.
	(__gg__ord): Likewise.
	(__gg__rem): Likewise.
	(__gg__trim): Likewise.
	(__gg__random): Likewise.
	(__gg__reverse): Likewise.
	(__gg__sign): Likewise.
	(__gg__sin): Likewise.
	(__gg__sqrt): Likewise.
	(__gg__tan): Likewise.
	(__gg__test_date_yyyymmdd): Likewise.
	(__gg__test_day_yyyyddd): Likewise.
	(__gg__upper_case): Likewise.
	(__gg__year_to_yyyy): Likewise.
	(gets_int): Likewise.
	(gets_year): Likewise.
	(gets_month): Likewise.
	(gets_day): Likewise.
	(gets_day_of_week): Likewise.
	(gets_day_of_year): Likewise.
	(gets_week): Likewise.
	(gets_hours): Likewise.
	(gets_minutes): Likewise.
	(gets_seconds): Likewise.
	(gets_nanoseconds): Likewise.
	(fill_cobol_tm): Likewise.
	(__gg__test_formatted_datetime): Likewise.
	(__gg__integer_of_formatted_date): Likewise.
	(__gg__seconds_from_formatted_time): Likewise.
	(__gg__hex_of): Likewise.
	(__gg__highest_algebraic): Likewise.
	(__gg__lowest_algebraic): Likewise.
	(floating_format_tester): Likewise.
	(__gg__numval_f): Likewise.
	(__gg__test_numval_f): Likewise.
	(ismatch): Likewise.
	(iscasematch): Likewise.
	(strstr): Likewise.
	(strcasestr): Likewise.
	(strlaststr): Likewise.
	(strcaselaststr): Likewise.
	(__gg__substitute): Likewise.
	(__gg__locale_compare): Likewise.
	(__gg__locale_date): Likewise.
	(__gg__locale_time): Likewise.
	(__gg__locale_time_from_seconds): Likewise.
	* libgcobol.cc (class ec_status_t): Likewise.
	(__gg__set_truncation_mode): Likewise.
	(malloc): Likewise.
	(__gg__mabort): Likewise.
	(__gg__resize_int_p): Likewise.
	(__gg__resize_treeplet): Likewise.
	(var_is_refmod): Likewise.
	(value_is_too_big): Likewise.
	(__gg__string_to_alpha_edited_ascii): Likewise.
	(int128_to_field): Likewise.
	(edited_to_binary): Likewise.
	(get_binary_value_local): Likewise.
	(__gg__get_date_yymmdd): Likewise.
	(__gg__get_date_yyyymmdd): Likewise.
	(__gg__get_date_yyddd): Likewise.
	(__gg__get_yyyyddd): Likewise.
	(__gg__get_date_dow): Likewise.
	(get_scaled_rdigits): Likewise.
	(format_for_display_internal): Likewise.
	(compare_88): Likewise.
	(get_float128): Likewise.
	(compare_field_class): Likewise.
	(compare_strings): Likewise.
	(__gg__compare_2): Likewise.
	(__gg__sort_table): Likewise.
	(init_var_both): Likewise.
	(alpha_to_alpha_move_from_location): Likewise.
	(alpha_to_alpha_move): Likewise.
	(__gg__move): Likewise.
	(__gg__move_literala): Likewise.
	(__gg__sort_workfile): Likewise.
	(__gg__merge_files): Likewise.
	(normalize_id): Likewise.
	(inspect_backward_format_1): Likewise.
	(__gg__inspect_format_1): Likewise.
	(inspect_backward_format_2): Likewise.
	(__gg__inspect_format_2): Likewise.
	(__gg__inspect_format_4): Likewise.
	(move_string): Likewise.
	(__gg__string): Likewise.
	(display_both): Likewise.
	(__gg__display_string): Likewise.
	(__gg__accept): Likewise.
	(__gg__binary_value_from_qualified_field): Likewise.
	(__gg__float128_from_qualified_field): Likewise.
	(float128_to_int128): Likewise.
	(float128_to_location): Likewise.
	(__gg__set_initial_switch_value): Likewise.
	(is_numeric_display_numeric): Likewise.
	(is_packed_numeric): Likewise.
	(is_alpha_a_number): Likewise.
	(__gg__classify): Likewise.
	(__gg__accept_envar): Likewise.
	(__gg__set_envar): Likewise.
	(command_line_plan_b): Likewise.
	(__gg__get_command_line): Likewise.
	(__gg__set_pointer): Likewise.
	(__gg__ascii_to_internal_field): Likewise.
	(__gg__internal_to_console_in_place): Likewise.
	(__gg__routine_to_call): Likewise.
	(__gg__fetch_call_by_value_value): Likewise.
	(__gg__assign_value_from_stack): Likewise.
	(__gg__literaln_alpha_compare): Likewise.
	(string_in): Likewise.
	(__gg__unstring): Likewise.
	(local_ec_type_of): Likewise.
	(struct exception_descr_t): Likewise.
	(struct cbl_exception_t): Likewise.
	(cbl_enabled_exception_t: Likewise.: Likewise.dump): Likewise.
	(__gg__match_exception): Likewise.
	(__gg__float128_from_location): Likewise.
	(__gg__integer_from_float128): Likewise.
	(__gg__set_exception_file): Likewise.
	(__gg__func_exception_file): Likewise.
	(__gg__set_exception_code): Likewise.
	(__gg__is_float_infinite): Likewise.
	(__gg__float32_from_128): Likewise.
	(__gg__float32_from_64): Likewise.
	(__gg__float64_from_128): Likewise.
	(__gg__copy_as_big_endian): Likewise.
	(__gg__get_figconst_data): Likewise.
	(find_in_dirs): Likewise.
	(__gg__function_handle_from_cobpath): Likewise.
	(__gg__just_mangle_name): Likewise.
	(__gg__function_handle_from_literal): Likewise.
	(__gg__function_handle_from_name): Likewise.
	(__gg__mirror_range): Likewise.
	(__gg__deallocate): Likewise.
	(__gg__allocate): Likewise.
	(__gg__module_name): Likewise.
	(__gg__set_env_name): Likewise.
	(__gg__set_env_value): Likewise.
	* libgcobol.h (__gg__mabort): Likewise.
	(massert): Likewise.
	(PTRCAST): Likewise.
	(__gg__float128_from_location): Likewise.
	(__gg__set_exception_file): Likewise.
	(__gg__binary_value_from_qualified_field): Likewise.
	(__gg__float128_from_qualified_field): Likewise.
	* valconv.cc (__gg__realloc_if_necessary): Likewise.
	(__gg__alphabet_create): Likewise.
	(__gg__string_to_numeric_edited): Likewise.
	(__gg__string_to_alpha_edited): Likewise.
	* valconv.h: Likewise.
2025-06-04 11:31:51 -04:00

2166 lines
66 KiB
C++

/*
* Copyright (c) 2021-2025 Symas Corporation
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following disclaimer
* in the documentation and/or other materials provided with the
* distribution.
* * Neither the name of the Symas Corporation nor the names of its
* contributors may be used to endorse or promote products derived from
* this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include <fcntl.h>
#include <unistd.h>
#include <cctype>
#include <cerrno>
#include <cmath>
#include <cfenv>
#include <cstdio>
#include <cstdlib>
#include <cstring>
#include <ctime>
#include <algorithm>
#include <vector>
#include "config.h"
#include "libgcobol-fp.h"
#include "ec.h"
#include "common-defs.h"
#include "io.h"
#include "gcobolio.h"
#include "libgcobol.h"
#include "gmath.h"
#include "gcobolio.h"
#include <sys/mman.h>
#include <sys/stat.h>
#include <sys/types.h>
#define MAX_INTERMEDIATE_BITS 126
#define MAX_INTERMEDIATE_DECIMALS 16
static int
conditional_stash( cblc_field_t *destination,
size_t destination_o,
size_t destination_s,
bool on_error_flag,
__int128 value,
int rdigits,
cbl_round_t rounded)
{
int retval = compute_error_none;
if( !on_error_flag )
{
// It's an uncomplicated assignment, because there was no
// ON SIZE ERROR phrase
__gg__int128_to_qualified_field(destination,
destination_o,
destination_s,
value,
rdigits,
rounded,
&retval);
}
else
{
// This is slightly more complex, because in the event of a
// SIZE ERROR. we need to leave the original value untouched
unsigned char *stash = static_cast<unsigned char *>(malloc(destination_s));
massert(stash);
memcpy(stash, destination->data+destination_o, destination_s);
__gg__int128_to_qualified_field(destination,
destination_o,
destination_s,
value,
rdigits,
rounded,
&retval);
if( retval )
{
// Because there was a size error, we will report that
// upon return, and we need to put back the original value:
memcpy(destination->data+destination_o, stash, destination_s);
}
free(stash);
}
return retval;
}
static int
conditional_stash( cblc_field_t *destination,
size_t destination_o,
size_t destination_s,
bool on_error_flag,
GCOB_FP128 value,
cbl_round_t rounded)
{
int retval = compute_error_none;
if( !on_error_flag )
{
// It's an uncomplicated assignment, because there was no
// ON SIZE ERROR phrase
__gg__float128_to_qualified_field(destination,
destination_o,
value,
rounded,
&retval);
}
else
{
// This is slightly more complex, because in the event of a
// SIZE ERROR. we need to leave the original value untouched
assert(destination_s);
unsigned char *stash = static_cast<unsigned char *>(malloc(destination_s));
massert(stash);
memcpy(stash, destination->data+destination_o, destination_s);
__gg__float128_to_qualified_field(destination,
destination_o,
value,
rounded,
&retval);
if( retval )
{
// Because there was a size error, we will report that
// upon return, and we need to put back the original value:
memcpy(destination->data+destination_o, stash, destination_s);
}
free(stash);
}
return retval;
}
static
GCOB_FP128
divide_helper_float(GCOB_FP128 a_value,
GCOB_FP128 b_value,
int *compute_error)
{
if( b_value == 0 )
{
// Can't divide by zero
*compute_error |= compute_error_divide_by_zero;
return a_value;
}
// Do the actual division, giving us 0.399999999999999999999999999999999971
a_value /= b_value;
if( __builtin_isinf(a_value) )
{
*compute_error |= compute_error_overflow;
return 0;
}
if( __builtin_isnan(a_value) )
{
*compute_error |= compute_error_underflow;
return 0;
}
return a_value;
}
static
GCOB_FP128
multiply_helper_float(GCOB_FP128 a_value,
GCOB_FP128 b_value,
int *compute_error)
{
a_value *= b_value;
if( __builtin_isinf(a_value) )
{
*compute_error |= compute_error_overflow;
return 0;
}
if( __builtin_isnan(a_value) )
{
*compute_error |= compute_error_underflow;
return 0;
}
return a_value;
}
static
GCOB_FP128
addition_helper_float(GCOB_FP128 a_value,
GCOB_FP128 b_value,
int *compute_error)
{
a_value += b_value;
if( __builtin_isinf(a_value) )
{
*compute_error |= compute_error_overflow;
return 0;
}
if( __builtin_isnan(a_value) )
{
*compute_error |= compute_error_underflow;
return 0;
}
return a_value;
}
static
GCOB_FP128
subtraction_helper_float(GCOB_FP128 a_value,
GCOB_FP128 b_value,
int *compute_error)
{
a_value -= b_value;
if( __builtin_isinf(a_value) )
{
*compute_error |= compute_error_overflow;
return 0;
}
if( __builtin_isnan(a_value) )
{
*compute_error |= compute_error_underflow;
return 0;
}
return a_value;
}
extern "C"
void
__gg__pow( cbl_arith_format_t,
size_t,
size_t,
size_t,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
cblc_field_t **B = __gg__treeplet_2f;
const size_t *B_o = __gg__treeplet_2o;
const size_t *B_s = __gg__treeplet_2s;
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
GCOB_FP128 avalue = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
GCOB_FP128 bvalue = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
GCOB_FP128 tgt_value;
if( avalue == 0 && bvalue == 0 )
{
*compute_error |= compute_error_exp_zero_by_zero;
tgt_value = 1;
}
else if(avalue == 0 && bvalue < 0 )
{
*compute_error |= compute_error_exp_zero_by_minus;
tgt_value = 0;
}
else
{
// Calculate our answer, in floating point:
errno = 0;
feclearexcept(FE_ALL_EXCEPT);
tgt_value = FP128_FUNC(pow)(avalue, bvalue);
if( errno || fetestexcept(FE_INVALID | FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW) )
{
// One of a large number of errors took place. See math_error(7) and
// pow(3). Let's just use this last error as a grab-bag; I didn't
// care to go down the rabbit hole of figuring out if a floating point
// number did or did not have a fractional part. That way lies
// madness.
*compute_error |= compute_error_exp_minus_by_frac;
// This kind of error doesn't overwrite the target, so the returned
// value is not relevant. Make it zero to avoid overheating the
// converstion routine
tgt_value = 0;
}
}
if( !(*compute_error & compute_error_exp_minus_by_frac) )
{
*compute_error |= conditional_stash(C[0],
C_o[0],
C_s[0],
(on_error_flag & ON_SIZE_ERROR),
tgt_value,
*rounded);
}
}
extern "C"
void
__gg__process_compute_error(int compute_error)
{
// This routine gets called after a series of parser_op operations is
// complete (see parser_assign()) when the source code didn't specify
// an ON SIZE ERROR clause.
if( compute_error & compute_error_divide_by_zero)
{
exception_raise(ec_size_zero_divide_e);
}
else if( compute_error & compute_error_truncate )
{
exception_raise(ec_size_truncation_e);
}
else if( compute_error & ( compute_error_exp_zero_by_zero
| compute_error_exp_zero_by_minus
| compute_error_exp_minus_by_frac ) )
{
exception_raise(ec_size_exponentiation_e);
}
else if( compute_error & compute_error_overflow )
{
exception_raise(ec_size_overflow_e);
}
else if( compute_error & compute_error_underflow )
{
exception_raise(ec_size_underflow_e);
}
}
typedef unsigned __int128 uint128;
typedef struct int256
{
union
{
unsigned char data[32];
uint64_t i64 [4];
uint128 i128[2];
};
}int256;
static int
multiply_int256_by_int64(int256 &product, const uint64_t multiplier)
{
// Typical use of this routine is multiplying a temporary value by
// a factor of ten. This is effectively left-shifting by decimal
// digits. See scale_int256_by_digits
uint64_t overflows[5] = {};
for(int i=0; i<4; i++)
{
uint128 temp = (uint128)product.i64[i] * multiplier;
product.i64[i] = *PTRCAST(uint64_t, &temp);
overflows[i+1] = *PTRCAST(uint64_t, PTRCAST(uint8_t, &temp) + 8);
}
for(int i=1; i<4; i++)
{
product.i64[i] += overflows[i];
if(product.i64[i] < overflows[i])
{
overflows[i+1] += 1;
}
}
// Indicate that an overflow took place. This is not useful unless the int256
// is known to be positive.
return overflows[4];
}
static int
add_int256_to_int256(int256 &sum, const int256 &addend)
{
uint128 overflows[3] = {};
for(int i=0; i<2; i++)
{
sum.i128[i] += addend.i128[i];
if( sum.i128[i] < addend.i128[i] )
{
overflows[i+1] = 1;
}
}
if( overflows[1] )
{
sum.i128[1] += overflows[1];
if( sum.i128[1] == 0 )
{
overflows[2] = 1;
}
}
// Indicate that an overflow took place. This is not useful unless the two
// values are known to be positive.
return (int)overflows[2];
}
static void
negate_int256(int256 &val)
{
val.i128[0] = ~val.i128[0];
val.i128[1] = ~val.i128[1];
val.i128[0] += 1;
if( !val.i128[0] )
{
val.i128[1] += 1;
}
}
static int
subtract_int256_from_int256(int256 &difference, int256 subtrahend)
{
negate_int256(subtrahend);
return add_int256_to_int256(difference, subtrahend);
}
static void
scale_int256_by_digits(int256 &val, int digits)
{
uint64_t pot;
while(digits > 17)
{
pot = (uint64_t)__gg__power_of_ten(17);
multiply_int256_by_int64(val, pot);
digits -= 17;
}
pot = (uint64_t)__gg__power_of_ten(digits);
multiply_int256_by_int64(val, pot);
}
static void
divide_int256_by_int64(int256 &val, uint64_t divisor)
{
// val needs to be a positive number
uint128 temp = 0;
for( int i=3; i>=0; i-- )
{
// Left shift temp 64 bits:
*PTRCAST(uint64_t, ((PTRCAST(uint8_t, &temp))+8))
= *PTRCAST(uint64_t, ((PTRCAST(uint8_t, &temp))+0));
// Put the high digit of val into the bottom of temp
*PTRCAST(uint64_t, ((PTRCAST(uint8_t, &temp))+0)) = val.i64[i];
// Divide that combinary by divisor to get the new digits
val.i64[i] = temp / divisor;
// And the new temp is that combination modulo divisor
temp = temp % divisor;
}
}
static int
squeeze_int256(int256 &val, int &rdigits)
{
int overflow = 0;
// It has been decreed that at this juncture the result must fit into
// MAX_FIXED_POINT_DIGITS. If the result does not, we have an OVERFLOW
// error.
int is_negative = val.data[31] & 0x80;
if( is_negative )
{
negate_int256(val);
}
// As long as there are some decimal places left, we hold our nose and
// right-shift a too-large value rightward by decimal digits. In other
// words, we truncate the fractional part to make room for the integer part:
while(rdigits > 0 && val.i128[1] )
{
divide_int256_by_int64(val, 10UL);
rdigits -= 1;
}
// At this point, to be useful, val has to have fewer than 128 bits:
if( val.i128[1] )
{
overflow = compute_error_overflow;
}
else
{
// We know that it has fewer than 128 bits. But the remaining 128 bits need
// to be less than 10^MAX_FIXED_POINT_DIGITS. This gets a bit nasty here,
// since at this writing the gcc compiler doesn't understand 128-bit
// constants. So, we are forced into some annoying compiler gymnastics.
#if MAX_FIXED_POINT_DIGITS != 37
#error MAX_FIXED_POINT_DIGITS needs to be 37
#endif
// These sixteen bytes comprise the binary value of 10^38
static const uint8_t C1038[] = {0x00, 0x00, 0x00, 0x00, 0x40, 0x22, 0x8a, 0x09,
0x7a, 0xc4, 0x86, 0x5a, 0xa8, 0x4c, 0x3b, 0x4b};
static const uint128 biggest = *reinterpret_cast<const uint128 *>(C1038);
// If we still have some rdigits to throw away, we can keep shrinking
// the value:
while(rdigits > 0 && val.i128[0] >= biggest )
{
divide_int256_by_int64(val, 10UL);
rdigits -= 1;
}
// And we have to make sure that rdigits isn't too big
while(rdigits > MAX_FIXED_POINT_DIGITS)
{
divide_int256_by_int64(val, 10UL);
rdigits -= 1;
}
if( val.i128[0] >= biggest )
{
overflow = compute_error_overflow;
}
}
if( is_negative )
{
negate_int256(val);
}
return overflow;
}
static void
get_int256_from_qualified_field(int256 &var,
int &rdigits,
const cblc_field_t *field,
size_t field_o,
size_t field_s)
{
var.i128[0] = (uint128)__gg__binary_value_from_qualified_field( &rdigits,
field,
field_o,
field_s);
if( var.data[15] & 0x80 )
{
// This value is negative, so extend the sign bit:
memset(var.data + 16, 0xFF, 16);
}
else
{
// This value is positive
memset(var.data + 16, 0x00, 16);
}
}
static int256 phase1_result;
static int phase1_rdigits;
static GCOB_FP128 phase1_result_float;
extern "C"
void
__gg__add_fixed_phase1( cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
const cbl_round_t *,
int ,
int *compute_error
)
{
// Our job is to add together the nA fixed-point values in the A[] array
// The result goes into the temporary phase1_result.
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
// Let us prime the pump with the first value of A[]
get_int256_from_qualified_field(phase1_result, phase1_rdigits, A[0], A_o[0], A_s[0]);
// We now go into a loop adding each of the A[] values to phase1_result:
for( size_t i=1; i<nA; i++ )
{
int temp_rdigits;
int256 temp = {};
get_int256_from_qualified_field(temp, temp_rdigits, A[i], A_o[i], A_s[i]);
// We have to scale the one with fewer rdigits to match the one with greater
// rdigits:
if( phase1_rdigits > temp_rdigits )
{
scale_int256_by_digits(temp, phase1_rdigits - temp_rdigits);
}
else if( phase1_rdigits < temp_rdigits )
{
scale_int256_by_digits(phase1_result, temp_rdigits - phase1_rdigits);
phase1_rdigits = temp_rdigits;
}
// The two numbers have the same number of rdigits. It's now safe to add
// them.
add_int256_to_int256(phase1_result, temp);
}
// phase1_result/phase1_rdigits now reflect the sum of all A[]
int overflow = squeeze_int256(phase1_result, phase1_rdigits);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
}
extern "C"
void
__gg__addf1_fixed_phase2( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
// This is the assignment phase of an ADD Format 1
// We take phase1_result and accumulate it into C
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
if( C[0]->type == FldFloat)
{
// The target we need to accumulate into is a floating-point number, so we
// need to convert our fixed-point intermediate into floating point and
// proceed accordingly.
// Convert the intermediate
GCOB_FP128 value_a = (GCOB_FP128)phase1_result.i128[0];
value_a /= __gg__power_of_ten(phase1_rdigits);
// Pick up the target
GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
value_a += value_b;
// At this point, we assign running_sum to *C.
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
value_a,
*rounded++);
}
else
{
// We have a fixed-point intermediate, and we are accumulating intoi a
// fixed point target.
int256 value_a = phase1_result;
int rdigits_a = phase1_rdigits;
int256 value_b = {};
int rdigits_b;
get_int256_from_qualified_field(value_b, rdigits_b, C[0], C_o[0], C_s[0]);
// We have to scale the one with fewer rdigits to match the one with greater
// rdigits:
if( rdigits_a > rdigits_b )
{
scale_int256_by_digits(value_b, rdigits_a - rdigits_b);
}
else if( rdigits_a < rdigits_b )
{
scale_int256_by_digits(value_a, rdigits_b - rdigits_a);
rdigits_a = rdigits_b;
}
// The two numbers have the same number of rdigits. It's now safe to add
// them.
add_int256_to_int256(value_a, value_b);
int overflow = squeeze_int256(value_a, rdigits_a);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
// At this point, we assign running_sum to *C.
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
value_a.i128[0],
rdigits_a,
*rounded++);
}
}
extern "C"
void
__gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
// This is the assignment phase of an ADD Format 2
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
// We take phase1_result and put it into C
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
if( C[0]->type == FldFloat)
{
// The target we need to accumulate into is a floating-point number, so we
// need to convert our fixed-point intermediate into floating point and
// proceed accordingly.
// Convert the intermediate
GCOB_FP128 value_a = (GCOB_FP128)phase1_result.i128[0];
value_a /= __gg__power_of_ten(phase1_rdigits);
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
value_a,
*rounded++);
}
else
{
// We have a fixed-point intermediate, and we are accumulating intoi a
// fixed point target.
int256 value_a = phase1_result;
int rdigits_a = phase1_rdigits;
int overflow = squeeze_int256(value_a, rdigits_a);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
// At this point, we assign that value to *C.
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
value_a.i128[0],
rdigits_a,
*rounded++);
}
}
extern "C"
void
__gg__add_float_phase1( cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
const cbl_round_t *,
int ,
int *compute_error
)
{
// Our job is to add together the nA floating-point values in the A[] array
// The result goes into the temporary phase1_result_ffloat.
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
// Let us prime the pump with the first value of A[]
phase1_result_float = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
// We now go into a loop adding each of the A[] values to phase1_result_flt:
for( size_t i=1; i<nA; i++ )
{
GCOB_FP128 temp = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
phase1_result_float = addition_helper_float(phase1_result_float,
temp,
compute_error);
}
}
extern "C"
void
__gg__addf1_float_phase2( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
// This is the assignment phase of an ADD Format 2
// We take phase1_result and accumulate it into C
GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
temp = addition_helper_float(temp, phase1_result_float, compute_error);
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
temp,
*rounded++);
}
extern "C"
void
__gg__float_phase2_assign_to_c( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
// This is the assignment phase of an ADD Format 2
// We take phase1_result and put it into C
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
phase1_result_float,
*rounded++);
}
extern "C"
void
__gg__addf3(cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
// This is an ADD Format 3. Each A[i] gets accumulated into each C[i]. When
// both are fixed, we do fixed arithmetic. When either is a FldFloat, we
// do floating-point arithmetic.
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
for(size_t i=0; i<nA; i++)
{
if( A[i]->type == FldFloat || C[i]->type == FldFloat )
{
GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
value_a = addition_helper_float(value_a, value_b, compute_error);
// At this point, we assign the sum to *C.
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
value_a,
*rounded++);
}
else
{
// We have are doing fixed-point arithmetic.
int256 value_a;
int rdigits_a;
int256 value_b;
int rdigits_b;
get_int256_from_qualified_field(value_a, rdigits_a, A[i], A_o[i], A_s[i]);
get_int256_from_qualified_field(value_b, rdigits_b, C[i], C_o[i], C_s[i]);
// We have to scale the one with fewer rdigits to match the one with greater
// rdigits:
if( rdigits_a > rdigits_b )
{
scale_int256_by_digits(value_b, rdigits_a - rdigits_b);
}
else if( rdigits_a < rdigits_b )
{
scale_int256_by_digits(value_a, rdigits_b - rdigits_a);
rdigits_a = rdigits_b;
}
// The two numbers have the same number of rdigits. It's now safe to add
// them.
add_int256_to_int256(value_a, value_b);
int overflow = squeeze_int256(value_a, rdigits_a);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
// At this point, we assign the sum to *C.
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
value_a.i128[0],
rdigits_a,
*rounded++);
}
}
}
extern "C"
void
__gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
// This is the assignment phase of an ADD Format 1
// We take phase1_result and subtrace it from C
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
if( C[0]->type == FldFloat)
{
// The target we need to accumulate into is a floating-point number, so we
// need to convert our fixed-point intermediate into floating point and
// proceed accordingly.
// Convert the intermediate
GCOB_FP128 value_a = (GCOB_FP128)phase1_result.i128[0];
value_a /= __gg__power_of_ten(phase1_rdigits);
// Pick up the target
GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
value_b -= value_a;
// At this point, we assign the difference to *C.
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
value_b,
*rounded++);
}
else
{
// We have a fixed-point intermediate, and we are accumulating intoi a
// fixed point target.
int256 value_a = phase1_result;
int rdigits_a = phase1_rdigits;
int256 value_b = {};
int rdigits_b;
get_int256_from_qualified_field(value_b, rdigits_b, C[0], C_o[0], C_s[0]);
// We have to scale the one with fewer rdigits to match the one with greater
// rdigits:
if( rdigits_a > rdigits_b )
{
scale_int256_by_digits(value_b, rdigits_a - rdigits_b);
rdigits_b = rdigits_a;
}
else if( rdigits_a < rdigits_b )
{
scale_int256_by_digits(value_a, rdigits_b - rdigits_a);
}
// The two numbers have the same number of rdigits. It's now safe to add
// them.
subtract_int256_from_int256(value_b, value_a);
int overflow = squeeze_int256(value_b, rdigits_b);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
// At this point, we assign running_sum to *C.
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
value_b.i128[0],
rdigits_b,
*rounded++);
}
}
extern "C"
void
__gg__subtractf2_fixed_phase1(cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
// This is the calculation phase of a fixed-point SUBTRACT Format 2
cblc_field_t **B = __gg__treeplet_2f;
const size_t *B_o = __gg__treeplet_2o;
const size_t *B_s = __gg__treeplet_2s;
// Add up all the A values
__gg__add_fixed_phase1( not_expected_e ,
nA,
0,
0,
rounded,
on_error_flag,
compute_error);
// Subtract that from the B value:
int256 value_a = phase1_result;
int rdigits_a = phase1_rdigits;
int256 value_b = {};
int rdigits_b;
get_int256_from_qualified_field(value_b, rdigits_b, B[0], B_o[0], B_s[0]);
// We have to scale the one with fewer rdigits to match the one with greater
// rdigits:
if( rdigits_a > rdigits_b )
{
scale_int256_by_digits(value_b, rdigits_a - rdigits_b);
rdigits_b = rdigits_a;
}
else if( rdigits_a < rdigits_b )
{
scale_int256_by_digits(value_a, rdigits_b - rdigits_a);
}
// The two numbers have the same number of rdigits. It's now safe to add
// them.
subtract_int256_from_int256(value_b, value_a);
int overflow = squeeze_int256(value_b, rdigits_b);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
phase1_result = value_b;
phase1_rdigits = rdigits_b;
}
extern "C"
void
__gg__subtractf1_float_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
// This is the assignment phase of an ADD Format 2
// We take phase1_result and subtract it from C
GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
temp = subtraction_helper_float(temp, phase1_result_float, compute_error);
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
temp,
*rounded++);
}
extern "C"
void
__gg__subtractf2_float_phase1(cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
// This is the calculation phase of a fixed-point SUBTRACT Format 2
cblc_field_t **B = __gg__treeplet_2f;
const size_t *B_o = __gg__treeplet_2o;
const size_t *B_s = __gg__treeplet_2s;
// Add up all the A values
__gg__add_float_phase1( not_expected_e ,
nA,
0,
0,
rounded,
on_error_flag,
compute_error
);
// Subtract that from the B value:
GCOB_FP128 value_b = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
// The two numbers have the same number of rdigits. It's now safe to add
// them.
phase1_result_float = subtraction_helper_float(value_b, phase1_result_float, compute_error);
}
extern "C"
void
__gg__subtractf3( cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
// This is an ADD Format 3. Each A[i] gets accumulated into each C[i]. Each
// SUBTRACTION is treated separately.
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
for(size_t i=0; i<nA; i++)
{
if( A[i]->type == FldFloat || C[i]->type == FldFloat)
{
GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
value_b = subtraction_helper_float(value_b, value_a, compute_error);
// At this point, we assign the sum to *C.
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
value_b,
*rounded++);
}
else
{
// We are doing fixed-point subtraction.
int256 value_a;
int rdigits_a;
int256 value_b;
int rdigits_b;
get_int256_from_qualified_field(value_a, rdigits_a, A[i], A_o[i], A_s[i]);
get_int256_from_qualified_field(value_b, rdigits_b, C[i], C_o[i], C_s[i]);
// We have to scale the one with fewer rdigits to match the one with greater
// rdigits:
if( rdigits_a > rdigits_b )
{
scale_int256_by_digits(value_b, rdigits_a - rdigits_b);
rdigits_b = rdigits_a;
}
else if( rdigits_a < rdigits_b )
{
scale_int256_by_digits(value_a, rdigits_b - rdigits_a);
}
// The two numbers have the same number of rdigits. It's now safe to add
// them.
subtract_int256_from_int256(value_b, value_a);
int overflow = squeeze_int256(value_b, rdigits_b);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
// At this point, we assign the sum to *C.
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
value_b.i128[0],
rdigits_b,
*rounded++);
}
}
}
static bool multiply_intermediate_is_float;
static GCOB_FP128 multiply_intermediate_float;
static __int128 multiply_intermediate_int128;
static int multiply_intermediate_rdigits;
extern "C"
void
__gg__multiplyf1_phase1(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *,
int ,
int *)
{
// We are getting just the one value, which we are converting to the necessary
// intermediate form
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
if( A[0]->type == FldFloat )
{
multiply_intermediate_is_float = true;
multiply_intermediate_float = __gg__float128_from_qualified_field(A[0],
A_o[0],
A_s[0]);
}
else
{
multiply_intermediate_is_float = false;
multiply_intermediate_int128 =
__gg__binary_value_from_qualified_field(&multiply_intermediate_rdigits,
A[0],
A_o[0],
A_s[0]);
}
}
static
void multiply_int128_by_int128(int256 &ABCD,
__int128 ab_value,
__int128 cd_value)
{
int is_negative = ( (PTRCAST(uint8_t, (&ab_value)))[15]
^(PTRCAST(uint8_t, (&cd_value)))[15]) & 0x80;
if( ab_value < 0 )
{
ab_value = -ab_value;
}
if( cd_value < 0 )
{
cd_value = -cd_value;
}
uint128 AC00;
uint128 AD0;
uint128 BC0;
uint128 BD;
// Let's extract the digits.
uint64_t a = *PTRCAST(uint64_t, (PTRCAST(unsigned char, (&ab_value))+8));
uint64_t b = *PTRCAST(uint64_t, (PTRCAST(unsigned char, (&ab_value))+0));
uint64_t c = *PTRCAST(uint64_t, (PTRCAST(unsigned char, (&cd_value))+8));
uint64_t d = *PTRCAST(uint64_t, (PTRCAST(unsigned char, (&cd_value))+0));
// multiply (a0 + b) * (c0 + d)
AC00 = (uint128)a * c;
AD0 = (uint128)a * d;
BC0 = (uint128)b * c;
BD = (uint128)b * d;
// ABCD is the sum of those four pieces
int256 temp;
ABCD.i128[1] = 0;
ABCD.i128[0] = BD;
temp.i64[3] = 0;
memcpy(&temp.i64[1], &BC0, 16);
temp.i64[0] = 0;
add_int256_to_int256(ABCD, temp);
memcpy(&temp.i64[1], &AD0, 16);
add_int256_to_int256(ABCD, temp);
temp.i64[1] = 0;
memcpy(&temp.i64[2], &AC00, 16);
add_int256_to_int256(ABCD, temp);
// ABCD is now a 256-bit integer with rdigits decimal places
if(is_negative)
{
negate_int256(ABCD);
}
}
extern "C"
void
__gg__multiplyf1_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
int error_this_time=0;
GCOB_FP128 a_value;
GCOB_FP128 b_value;
if( multiply_intermediate_is_float )
{
a_value = multiply_intermediate_float;
if( C[0]->type == FldFloat )
{
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
}
else
{
// float times fixed
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
}
}
else
{
if( C[0]->type == FldFloat )
{
// gixed * float
a_value = (GCOB_FP128) multiply_intermediate_int128;
if( multiply_intermediate_rdigits )
{
a_value /= (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
}
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
}
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 cd_rdigits;
__int128 ab_value = multiply_intermediate_int128;
__int128 cd_value = __gg__binary_value_from_qualified_field(&cd_rdigits, C[0], C_o[0], C_s[0]);
int256 ABCD;
int rdigits = multiply_intermediate_rdigits + cd_rdigits;
multiply_int128_by_int128(ABCD, ab_value, cd_value);
int overflow = squeeze_int256(ABCD, rdigits);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
// At this point, we assign running_sum to *C.
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
ABCD.i128[0],
rdigits,
*rounded++);
goto done;
}
}
float_float:
a_value = multiply_helper_float(a_value, b_value, &error_this_time);
if( error_this_time && on_size_error)
{
*compute_error |= error_this_time;
}
else
{
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
a_value,
*rounded);
}
done:
return;
}
extern "C"
void
__gg__multiplyf2( cbl_arith_format_t ,
size_t ,
size_t ,
size_t nC,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
cblc_field_t **B = __gg__treeplet_2f;
const size_t *B_o = __gg__treeplet_2o;
const size_t *B_s = __gg__treeplet_2s;
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
bool got_float = false;
GCOB_FP128 product_float;
int256 product_fix;
int product_fix_digits;
if( A[0]->type == FldFloat || B[0]->type == FldFloat )
{
GCOB_FP128 a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
GCOB_FP128 b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
product_float = multiply_helper_float(a_value, b_value, compute_error);
got_float = true;
}
else
{
int a_rdigits;
int b_rdigits;
__int128 a_value = __gg__binary_value_from_qualified_field(&a_rdigits, A[0], A_o[0], A_s[0]);
__int128 b_value = __gg__binary_value_from_qualified_field(&b_rdigits, B[0], B_o[0], B_s[0]);
product_fix_digits = a_rdigits + b_rdigits;
multiply_int128_by_int128(product_fix, a_value, b_value);
int overflow = squeeze_int256(product_fix, product_fix_digits);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
}
for(size_t i=0; i<nC; i++)
{
if( got_float )
{
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
product_float,
*rounded++);
}
else
{
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
product_fix.i128[0],
product_fix_digits,
*rounded++);
}
}
}
static void
shift_in_place128(uint8_t *buf, int size, int bits)
{
// Assume that size in bytes is some multiple of sixteen. That is, the
// buffer we are shifting is made up of either two 128-bit bit values (for
// an int256) or three 128-bit values (an int384)
// "bits" is a value from zero to 127
if( !bits )
{
return;
}
size_t places = size/16; // This is either two or three
uint128 temp;
uint128 overflow = 0;
uint128 *as128 = PTRCAST(uint128, buf);
for( size_t i=0; i<places; i++ )
{
temp = as128[i] >> (128 - bits);
as128[i] <<= bits;
as128[i] += overflow;
overflow = temp;
}
}
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wunused-function"
static char *
int256_as_decimal(int256 val)
{
char ach[120];
memset(ach, 0, sizeof(ach));
strcpy(ach, "0");
int index = 0;
while(val.i128[0] || val.i128[1])
{
int256 before;
int256 after;
before = val;
after = val;
divide_int256_by_int64(after, 10);
multiply_int256_by_int64(after, 10);
uint64_t digit = before.i64[0] - after.i64[0];
ach[index++] = digit + '0';
divide_int256_by_int64(val, 10);
}
if( !index )
{
index = 1;
}
index -= 1;
int r = 0;
static char retval[120];
while(index >= 0)
{
retval[r++] = ach[index--];
}
retval[r++] = '\0';
return retval;
}
#pragma GCC diagnostic pop
static void
divide_int128_by_int128(int256 &quotient,
int &quotient_rdigits,
__int128 dividend,
int dividend_rdigits,
__int128 divisor,
int divisor_rdigits,
int *compute_error)
{
if( divisor == 0 )
{
*compute_error |= compute_error_divide_by_zero;
memset(&quotient, 0, sizeof(quotient));
memcpy(&quotient, &dividend, 8);
quotient_rdigits = dividend_rdigits;
return;
}
bool is_negative = false;
if(dividend < 0)
{
is_negative = !is_negative;
dividend = -dividend;
}
if(divisor < 0)
{
is_negative = !is_negative;
divisor = -divisor;
}
// We are going to be referencing the 64-bit pices of the 128-bit divisor:
uint64_t *divisor64 = PTRCAST(uint64_t, &divisor);
quotient.i128[1] = 0;
quotient.i128[0] = dividend;
// In order to get 0.3333333.... from 1 / 3, we are going to scale up the
// numerator so that it has 37 rdigits:
int scale = MAX_FIXED_POINT_DIGITS;
scale_int256_by_digits(quotient, scale);
quotient_rdigits = scale + dividend_rdigits - divisor_rdigits;
// Now, let's see if we can do a simple divide-by-single-place calculation:
if( divisor64[1] == 0 )
{
// Yes! The divisor fits into 64 bits:
divide_int256_by_int64(quotient, (uint64_t)divisor);
}
else
{
// We have to do long division, and that means Knuth's Algorithm D. Let's
// review where we are.
//
// We are using 64-bit places to divide one 128-bit number by another. We
// know that both are positive. So, we are dividing
//
// AB by CD, where we know C is non-zero.
//
// Because we want fractional digits to the right, we multiplied by 10**37,
// which is smaller than 2**64, so we have one additional place:
//
// ABx by CD
//
// Algorithm D requires that we left-shift ABX and CD by enough bits to make
// turn on high-order by of CD. This will be a value between 1 and 63
// shifts, resulting in
//
// ABxy by CD.
//
// We can know that the quotient will have at most two places. We can see
// this in the decimal analogy. The worst case scenario is dividing
//
// 99 by 10
//
// We multiply the top by 10 to give us one fractional decimal place in the
// result:
//
// 990 by 10
//
// To satisfy Algorithm D's requirement that C be >= b/2, we multiply both
// dividend and divisor by 5:
//
// 4950 by 50
//
// And then we do the work that gives us the two-place answer of 99.
//
//
// Here is our four-place 256-bit "numerator"
int256 numerator;
// Copy the three-place ABx value into the numerator area
memcpy(&numerator, &quotient, sizeof(quotient));
// Calculate how many bits we need to shift CD to make the high-order bit
// turn on:
int bits_to_shift = 0;
int i=15;
while( (PTRCAST(uint8_t, &divisor))[i] == 0 )
{
i -= 1;
bits_to_shift += 8;
} uint8_t tail = ( PTRCAST(uint8_t, &divisor) )[i];
while( !(tail & 0x80) )
{
bits_to_shift += 1;
tail <<= 1;
}
// Shift both the numerator and the divisor that number of bits
shift_in_place128( PTRCAST(uint8_t, &numerator), sizeof(numerator), bits_to_shift);
shift_in_place128( PTRCAST(uint8_t, &divisor), sizeof(divisor), bits_to_shift);
// We are now ready to do the guess-multiply-subtract loop. We know that
// the result will have two places, so we know we are going to go through
// that loop two times. We will build the quotient from the high-order
// place down:
// Let's prime the pump by loading remnant with the A value of ABxyz
int q_place = 1;
memset(&quotient, 0, sizeof(quotient));
while( q_place >= 0 )
{
// We develop our guess for a quotient by dividing the top two places of
// the numerator area by C
uint128 temp;
uint64_t *temp64 = PTRCAST(uint64_t, &temp);
temp64[1] = numerator.i64[q_place+2];
temp64[0] = numerator.i64[q_place+1];
quotient.i64[q_place] = temp / divisor64[1];
// Now we multiply our 64-bit guess by the 128-bit CD to get the
// three-place value we are going to subtract from the numerator area.
uint64_t subber[3];
subber[2] = 0;
// Start with the bottom 128 bits of the "subber"
*PTRCAST(uint128, subber) = (uint128) divisor64[0] * quotient.i64[q_place];
// Get the next 128 bits of subber
temp = (uint128) divisor64[1] * quotient.i64[q_place];
// Add the top of the first product to the bottom of the second:
subber[1] += temp64[0];
// See if there was an overflow:
if( subber[1] < temp64[0] )
{
// There was an overflow
subber[2] = 1;
}
// And now put the top of the second product into place:
subber[2] += temp64[1];
// "subber" is now the three-place product of the two-place divisor times
// the one-place guess
// We now subtract the three-place subber from the appropriate place of
// the numerator:
uint64_t borrow = 0;
for(size_t j=0; j<3; j++)
{
if( numerator.i64[q_place + j] == 0 && borrow )
{
// We are subtracting from zero and we have a borrow. Leave the
// borrow on and just do the subtraction:
numerator.i64[q_place + j] -= subber[j];
}
else
{
uint64_t stash = numerator.i64[q_place + j];
numerator.i64[q_place + j] -= borrow;
numerator.i64[q_place + j] -= subber[j];
if( numerator.i64[q_place + j] > stash )
{
// After subtracting, the value got bigger, which means we have
// to borrow from the next value to the left
borrow = 1;
}
else
{
borrow = 0;
}
}
}
// The three-place subber has been removed from the numerator.
// Now Algorithm D comes back into play. Knuth has proved that the guess
// is usually correct, but sometimes can be one too large, which means
// that the numerator area goes negative. On rare occasions, the guess can
// be two too large. So, we have to make sure that the numerator area is
// actually positive by adding subber back in.
while( numerator.i64[q_place+2] & 0x8000000000000000UL )
{
// We need to add subber back into the numerator area
uint64_t carry = 0;
for(size_t ii=0; ii<3; ii++)
{
if( numerator.i64[q_place + ii] == 0xFFFFFFFFFFFFFFFFUL && carry )
{
// We are at the top and have a carry. Just leave the carry on
// and do the addition:
numerator.i64[q_place + ii] += subber[ii];
}
else
{
// We are not at the top.
uint64_t stash = numerator.i64[q_place + ii];
numerator.i64[q_place + ii] += carry;
numerator.i64[q_place + ii] += subber[ii];
if( numerator.i64[q_place + ii] < stash )
{
// The addition caused the result to get smaller, meaning that
// we wrapped around:
carry = 1;
}
else
{
carry = 0;
}
}
}
}
q_place -= 1;
}
}
if( is_negative )
{
negate_int256(quotient);
}
}
extern "C"
void
__gg__dividef1_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
int error_this_time=0;
GCOB_FP128 a_value;
GCOB_FP128 b_value;
if( multiply_intermediate_is_float )
{
a_value = multiply_intermediate_float;
if( C[0]->type == FldFloat )
{
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
}
else
{
// float times fixed
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
}
}
else
{
if( C[0]->type == FldFloat )
{
// gixed * float
a_value = (GCOB_FP128) multiply_intermediate_int128;
if( multiply_intermediate_rdigits )
{
a_value /= (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
}
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
}
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(&dividend_rdigits, C[0], C_o[0], C_s[0]);
int quotient_rdigits;
int256 quotient;
divide_int128_by_int128(quotient,
quotient_rdigits,
dividend,
dividend_rdigits,
multiply_intermediate_int128,
multiply_intermediate_rdigits,
compute_error);
int overflow = squeeze_int256(quotient, quotient_rdigits);
if( overflow )
{
*compute_error |= compute_error_overflow;
}
// At this point, we assign the quotient to *C.
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
quotient.i128[0],
quotient_rdigits,
*rounded++);
goto done;
}
}
float_float:
b_value = divide_helper_float(b_value, a_value, &error_this_time);
*compute_error |= error_this_time;
if( error_this_time && on_size_error)
{
}
else
{
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
b_value,
*rounded);
}
done:
return;
}
extern "C"
void
__gg__dividef23(cbl_arith_format_t ,
size_t ,
size_t ,
size_t nC,
const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **A = __gg__treeplet_1f;
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
cblc_field_t **B = __gg__treeplet_2f;
const size_t *B_o = __gg__treeplet_2o;
const size_t *B_s = __gg__treeplet_2s;
cblc_field_t **C = __gg__treeplet_3f;
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
int error_this_time=0;
if( A[0]->type == FldFloat || B[0]->type == FldFloat )
{
GCOB_FP128 a_value;
GCOB_FP128 b_value;
GCOB_FP128 c_value;
a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
c_value = divide_helper_float(a_value, b_value, &error_this_time);
*compute_error |= error_this_time;
if( !error_this_time )
{
for(size_t i=0; i<nC; i++)
{
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
c_value,
*rounded++);
}
}
}
else
{
// fixed divided by fixed
int dividend_rdigits;
__int128 dividend = __gg__binary_value_from_qualified_field(&dividend_rdigits, A[0], A_o[0], A_s[0]);
int divisor_rdigits;
__int128 divisor = __gg__binary_value_from_qualified_field(&divisor_rdigits, B[0], B_o[0], B_s[0]);
int quotient_rdigits;
int256 quotient;
divide_int128_by_int128(quotient,
quotient_rdigits,
dividend,
dividend_rdigits,
divisor,
divisor_rdigits,
compute_error);
*compute_error |= squeeze_int256(quotient, quotient_rdigits);
if( !*compute_error )
{
// At this point, we assign the quotient to *C.
for(size_t i=0; i<nC; i++)
{
*compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
on_size_error,
quotient.i128[0],
quotient_rdigits,
*rounded++);
}
}
}
}
extern "C"
void
__gg__dividef45(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
cbl_round_t *rounded_p,
int on_error_flag,
int *compute_error
)
{
cblc_field_t **A = __gg__treeplet_1f; // Numerator
const size_t *A_o = __gg__treeplet_1o;
const size_t *A_s = __gg__treeplet_1s;
cblc_field_t **B = __gg__treeplet_2f; // Denominator
const size_t *B_o = __gg__treeplet_2o;
const size_t *B_s = __gg__treeplet_2s;
cblc_field_t **C = __gg__treeplet_3f; // Has remainder, then quotient
const size_t *C_o = __gg__treeplet_3o;
const size_t *C_s = __gg__treeplet_3s;
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
int error_this_time=0;
if( A[0]->type == FldFloat || B[0]->type == FldFloat )
{
GCOB_FP128 a_value;
GCOB_FP128 b_value;
GCOB_FP128 c_value;
a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
c_value = divide_helper_float(a_value, b_value, &error_this_time);
*compute_error |= error_this_time;
if( !error_this_time )
{
*compute_error |= conditional_stash(C[1], C_o[1], C_s[1],
on_size_error,
c_value,
*rounded_p++);
// This is floating point, and there is a remainder, and we don't know
// what that means. Set the remainder to zero
if( !*compute_error )
{
c_value = 0;
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
c_value,
*rounded_p++);
}
}
}
else
{
// fixed divided by fixed
int dividend_rdigits;
__int128 dividend = __gg__binary_value_from_qualified_field(&dividend_rdigits, A[0], A_o[0], A_s[0]);
int divisor_rdigits;
__int128 divisor = __gg__binary_value_from_qualified_field(&divisor_rdigits, B[0], B_o[0], B_s[0]);
int quotient_rdigits;
int256 quotient;
divide_int128_by_int128(quotient,
quotient_rdigits,
dividend,
dividend_rdigits,
divisor,
divisor_rdigits,
compute_error);
*compute_error |= squeeze_int256(quotient, quotient_rdigits);
if( !*compute_error )
{
// We are going to need the unrounded quotient to calculate the remainder
__int128 unrounded_quotient = 0;
int unrounded_quotient_digits;
rounded_p += 1;// Skip the rounded value for the remainder
cbl_round_t rounded = *rounded_p;
switch(rounded)
{
case truncation_e:
{
*compute_error |= conditional_stash(C[1], C_o[1], C_s[1],
on_size_error,
quotient.i128[0],
quotient_rdigits,
*rounded_p++);
unrounded_quotient = __gg__binary_value_from_qualified_field(
&unrounded_quotient_digits,
C[1], C_o[1], C_s[1]);
break;
}
default:
{
conditional_stash(C[1], C_o[1], C_s[1],
false,
quotient.i128[0],
quotient_rdigits,
truncation_e);
unrounded_quotient = __gg__binary_value_from_qualified_field(
&unrounded_quotient_digits,
C[1], C_o[1], C_s[1]);
// At this point, we assign the rounded quotient to *C.
*compute_error |= conditional_stash(C[1], C_o[1], C_s[1],
on_size_error,
quotient.i128[0],
quotient_rdigits,
*rounded_p++);
break;
}
}
if( !*compute_error )
{
// We need to calculate the remainder
// Remainders in COBOL are seriously weird. The NIST suite
// has an example where 174 is divided by 16. The quotient
// is a 999.9, and the remainder is a 9999
// So, here goes: 174 by 16 is 10.875. The unrounded
// assignment to Q is thus 10.8
// You then multiply 10.8 by 16, giving 172.8
// That gets subtracted from 174, giving 1.2
// That gets assigned to the 9999 remainder, which is
// thus 1
// Any mathematician would walk away, slowly, shaking their head.
// We need to multiply the unrounded quotient by the divisor.
int256 temp;
int temp_rdigits;
// 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 = {};
memcpy(&odividend, &dividend, sizeof(dividend));
// We need to line up the rdigits so that we can subtract temp from
// odividend:
if( temp_rdigits < dividend_rdigits )
{
scale_int256_by_digits(temp, dividend_rdigits-temp_rdigits);
temp_rdigits = dividend_rdigits;
}
else if(temp_rdigits > dividend_rdigits)
{
scale_int256_by_digits(odividend, temp_rdigits-dividend_rdigits);
}
subtract_int256_from_int256(odividend, temp);
*compute_error |= squeeze_int256(odividend, temp_rdigits);
if( !*compute_error )
{
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
odividend.i128[0],
temp_rdigits,
truncation_e);
}
}
}
}
}