aboutsummaryrefslogtreecommitdiff
path: root/libgcobol
diff options
context:
space:
mode:
Diffstat (limited to 'libgcobol')
-rw-r--r--libgcobol/ChangeLog383
-rw-r--r--libgcobol/LICENSE27
-rw-r--r--libgcobol/charmaps.cc25
-rw-r--r--libgcobol/common-defs.h76
-rw-r--r--libgcobol/config.h.in3
-rwxr-xr-xlibgcobol/configure53
-rw-r--r--libgcobol/configure.ac11
-rw-r--r--libgcobol/constants.cc19
-rw-r--r--libgcobol/ec.h1
-rw-r--r--libgcobol/gcobolio.h3
-rw-r--r--libgcobol/gfileio.cc95
-rw-r--r--libgcobol/gmath.cc333
-rw-r--r--libgcobol/intrinsic.cc613
-rw-r--r--libgcobol/io.cc11
-rw-r--r--libgcobol/libgcobol.cc1520
-rw-r--r--libgcobol/libgcobol.h31
-rw-r--r--libgcobol/valconv.cc17
-rw-r--r--libgcobol/valconv.h8
18 files changed, 2037 insertions, 1192 deletions
diff --git a/libgcobol/ChangeLog b/libgcobol/ChangeLog
index fe41ffb..91a3b86 100644
--- a/libgcobol/ChangeLog
+++ b/libgcobol/ChangeLog
@@ -1,3 +1,386 @@
+2025-07-13 Robert Dubner <rdubner@symas.com>
+
+ * common-defs.h (PTRCAST): Moved here from libgcobol.h.
+ * libgcobol.h (PTRCAST): Deleted.
+
+2025-07-10 James K. Lowden <jklowden@cobolworx.com>
+
+ * common-defs.h (cdf_enabled_exceptions): Use new CDF state.
+
+2025-07-09 Robert Dubner <rdubner@symas.com>
+ James K. Lowden <jklowden@cobolworx.com>
+
+ * libgcobol.cc (__gg__accept_envar): ACCEPT/DISPLAY environment variables.
+ (accept_envar): Likewise.
+ (default_exception_handler): Refine system log entries.
+ (open_syslog): Likewise.
+ (__gg__set_env_name): ACCEPT/DISPLAY environment variables.
+ (__gg__get_env_name): ACCEPT/DISPLAY environment variables.
+ (__gg__get_env_value): ACCEPT/DISPLAY environment variables.
+ (__gg__set_env_value): ACCEPT/DISPLAY environment variables.
+ (__gg__fprintf_stderr): Adjust __attribute__ for printf.
+ (__gg__set_arg_num): ACCEPT/DISPLAY command-line arguments.
+ (__gg__accept_arg_value): ACCEPT/DISPLAY command-line arguments.
+ (__gg__get_file_descriptor): DISPLAY on os_filename[] /dev device.
+
+2025-06-20 James K. Lowden <jklowden@cobolworx.com>
+
+ * LICENSE: New file.
+
+2025-06-16 James K. Lowden <jklowden@cobolworx.com>
+
+ PR cobol/120621
+ * common-defs.h (class cbl_enabled_exceptions_t): Const parameter.
+
+2025-06-11 Robert Dubner <rdubner@symas.com>
+
+ PR cobol/119975
+ * intrinsic.cc (__gg__current_date): Eliminate CLOCK_REALTIME.
+ (__gg__seconds_past_midnight): Likewise.
+ (__gg__formatted_current_date): Likewise.
+ (__gg__random): Likewise.
+ (__gg__random_next): Likewise.
+ * libgcobol.cc: include <sys/time.h>.
+ (__gg__abort): Eliminate CLOCK_REALTIME.
+ (cobol_time): Likewise.
+ (get_time_nanoseconds): Rename.
+ (get_time_nanoseconds_local): Comment; Eliminate CLOCK_REALTIME.
+ (__gg__clock_gettime): Likewise.
+ (__gg__get_date_hhmmssff): Likewise.
+ * libgcobol.h (__gg__clock_gettime): Eliminate clockid_t from declaration.
+
+2025-06-06 Robert Dubner <rdubner@symas.com>
+ James K. Lowden <jklowden@cobolworx.com>
+
+ * common-defs.h (enum cbl_file_mode_t): Whitespace.
+ (enum file_stmt_t): Likewise.
+ (ec_cmp): Likewise.
+ (struct cbl_declarative_t): Add "explicit" keyword.
+ (class cbl_enabled_exceptions_t): Whitespace.
+ * gfileio.cc: Remove cppcheck comment.
+ * libgcobol.cc (class ec_status_t): Add "explicit" keyword.
+ (match_declarative): Remove %zu.
+ (default_exception_handler): Likwise.
+ (__gg__check_fatal_exception): Exception overhead.
+ (__gg__exception_push): Remove %zu.
+ (__gg__exception_pop): Likewise.
+ (cbl_enabled_exception_t::dump): Likewise.
+ (__gg__match_exception): Exception overhead; remove %zu.
+ (cbl_enabled_exceptions_t::dump): Remove %zu.
+ (__gg__set_exception_environment): Likewise.
+
+2025-06-05 Robert Dubner <rdubner@symas.com>
+
+ PR cobol/119975
+ * configure.ac: AC_CHECK_LIB(rt, clock_gettime).
+ * config.h.in: Likewise.
+ * configure: Likewise.
+ * gfileio.cc: Remove in-line cppcheck-suppress.
+ * intrinsic.cc (timespec_to_string): Use guarded clock_gettime().
+ (__gg__current_date): Likewise.
+ (__gg__seconds_past_midnight): Likewise.
+ (__gg__formatted_current_date): Likewise.
+ (__gg__random): Likewise.
+ (__gg__random_next): Likewise.
+ (__gg__when_compiled): Likewise.
+ * libgcobol.cc (cobol_time): Likewise.
+ (get_time_nanoseconds): Likewise.
+ (__gg__clock_gettime): Likewise.
+ (__gg__get_date_hhmmssff): Likewise.
+ * libgcobol.h (__gg__clock_gettime): Likewise.
+ (struct cbl_timespec): Likewise.
+
+2025-06-04 Robert Dubner <rdubner@symas.com>
+
+ 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-01 Robert Dubner <rdubner@symas.com>
+
+ PR cobol/119524
+ * libgcobol.cc (__gg__fprintf_stderr): New function.
+
+2025-05-20 Robert Dubner <rdubner@symas.com>
+ James K. Lowden <jklowden@cobolworx.com>
+
+ * charmaps.cc: Switch to C++ includes.
+ * common-defs.h: Likewise.
+ * constants.cc: Likewise.
+ * ec.h: Remove #include <assert.h>.
+ * gcobolio.h (GCOBOLIO_H_): Switch to C++ includes.
+ * gfileio.cc: Likewise.
+ * gmath.cc: Likewise.
+ * intrinsic.cc: Comment formatting; C++ includes.
+ * io.cc: C++ includes.
+ * libgcobol.cc: (__gg__stash_exceptions): Eliminate.
+ * valconv.cc: Switch to C++ includes.
+
+2025-05-20 Robert Dubner <rdubner@symas.com>
+
+ PR cobol/119885
+ * intrinsic.cc: (__gg__sqrt): Change test from <= zero to < zero.
+
+2025-05-16 Robert Dubner <rdubner@symas.com>
+
+ * common-defs.h (struct cbl_declarative_t): Eliminate blobl.
+ * libgcobol.cc (__gg__set_env_name): Code for ENVIRONMENT-NAME/VALUE.
+ (__gg__set_env_value): Likewise.
+
+2025-05-13 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
+
+ * libgcobol.cc [!LOG_PERROR] (LOG_PERROR): Provide fallback.
+
+2025-05-11 Robert Dubner <rdubner@symas.com>
+
+ PR cobol/119377
+ * common-defs.h: (struct cbl_declaratives_t): Change "bool global" to
+ "uint32_t global".
+
2025-05-10 Robert Dubner <rdubner@symas.com>
* common-defs.h (ec_cmp): Delete "getenv("match_declarative")" calls.
diff --git a/libgcobol/LICENSE b/libgcobol/LICENSE
new file mode 100644
index 0000000..3937993
--- /dev/null
+++ b/libgcobol/LICENSE
@@ -0,0 +1,27 @@
+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.
diff --git a/libgcobol/charmaps.cc b/libgcobol/charmaps.cc
index 8681f79..eb82609 100644
--- a/libgcobol/charmaps.cc
+++ b/libgcobol/charmaps.cc
@@ -29,14 +29,16 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <ctype.h>
-#include <stdio.h>
-#include <string.h>
-#include <time.h>
+#include <iconv.h>
+
+#include <cctype>
+#include <clocale>
+#include <cstdio>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <unordered_map>
-#include <locale.h>
-#include <iconv.h>
#include <vector>
#include "ec.h"
@@ -433,7 +435,7 @@ __gg__raw_to_ascii(char **dest, size_t *dest_size, const char *in, size_t length
size_t code_point;
// Pull the next code_point from the UTF-8 stream
- long unicode_point = extract_next_code_point((const unsigned char *)in,
+ long unicode_point = extract_next_code_point(reinterpret_cast<const unsigned char *>(in),
length,
position );
@@ -495,7 +497,7 @@ __gg__raw_to_ebcdic(char **dest, size_t *dest_size, const char *in, size_t lengt
}
// Pull the next code_point from the UTF-8 stream
- long unicode_point = extract_next_code_point( (const unsigned char *)in,
+ long unicode_point = extract_next_code_point( reinterpret_cast<const unsigned char *>(in),
length,
position );
// Check for that unicode code point in the subset of characters we
@@ -720,7 +722,8 @@ char *__gg__ebcdic_to_console(char **dest,
const size_t length)
{
static size_t ebcdic_size = MINIMUM_ALLOCATION_SIZE;
- static char *ebcdic = (char *)malloc(ebcdic_size);
+ static char *ebcdic = static_cast<char *>(malloc(ebcdic_size));
+ if(!ebcdic)abort();
__gg__realloc_if_necessary(&ebcdic, &ebcdic_size, length);
memcpy(ebcdic, str, length);
@@ -755,7 +758,7 @@ void __gg__console_to_ascii(char * const str, size_t length)
size_t code_point;
// Pull the next code_point from the UTF-8 stream
long unicode_point
- = extract_next_code_point( (const unsigned char *)str,
+ = extract_next_code_point( reinterpret_cast<const unsigned char *>(str),
length,
position );
if( unicode_point == -1 )
@@ -795,7 +798,7 @@ __gg__console_to_ebcdic(char * const str, size_t length)
size_t code_point;
// Pull the next code_point from the UTF-8 stream
long unicode_point
- = extract_next_code_point( (const unsigned char *)str,
+ = extract_next_code_point( reinterpret_cast<const unsigned char *>(str),
length,
position );
if( unicode_point == -1 )
diff --git a/libgcobol/common-defs.h b/libgcobol/common-defs.h
index e3471c5..15d0683 100644
--- a/libgcobol/common-defs.h
+++ b/libgcobol/common-defs.h
@@ -30,8 +30,9 @@
#ifndef COMMON_DEFS_H_
#define COMMON_DEFS_H_
-#include <stdio.h>
-#include <stdint.h>
+#include <cassert>
+#include <cstdio>
+#include <cstdint>
#include <list>
#define COUNT_OF(X) (sizeof(X) / sizeof(X[0]))
@@ -83,6 +84,14 @@
#define MINIMUM_ALLOCATION_SIZE 16
+// This was part of an exercise to make cppcheck shut up about invalid
+// pointer type conversions.
+// It was also to avoid having reinterpret_cast<> all over the place.
+// So, instead of reinterpret_cast<char *>(VALUE)
+// I sometimes use PTRCAST(char, VALUE)
+// Note that "(char *)" is implied by "PTRCAST(char, VALUE)"
+#define PTRCAST(TYPE, VALUE) static_cast<TYPE *>(static_cast<void *>(VALUE))
+
/*
* User-defined names in IBM COBOL can have at most 30 characters.
* For DBCS, the maximum is 14.
@@ -236,7 +245,7 @@ enum cbl_file_mode_t {
file_mode_output_e = 'w',
file_mode_extend_e = 'a',
file_mode_io_e = '+',
- file_mode_any_e,
+ file_mode_any_e,
};
enum cbl_round_t {
@@ -287,15 +296,15 @@ enum bitop_t {
};
enum file_stmt_t {
- file_stmt_delete_e,
- file_stmt_merge_e,
- file_stmt_read_e,
- file_stmt_rewrite_e,
- file_stmt_sort_e,
- file_stmt_start_e,
- file_stmt_write_e,
+ file_stmt_delete_e,
+ file_stmt_merge_e,
+ file_stmt_read_e,
+ file_stmt_rewrite_e,
+ file_stmt_sort_e,
+ file_stmt_start_e,
+ file_stmt_write_e,
};
-
+
enum file_close_how_t {
file_close_no_how_e = 0x00,
file_close_removal_e = 0x01,
@@ -411,14 +420,14 @@ ec_cmp( ec_type_t raised, ec_type_t ec )
{
if( raised == ec ) return true;
- // If both low bytes are nonzero, we had to match exactly, above.
+ // If both low bytes are nonzero, we had to match exactly, above.
if( (~EC_ALL_E & static_cast<uint32_t>(raised))
&&
(~EC_ALL_E & static_cast<uint32_t>(ec)) ) {
return false;
}
- // Level 1 and 2 have low byte of zero.
+ // Level 1 and 2 have low byte of zero.
// If one low byte is zero, see if they're the same kind.
return 0xFF < ( static_cast<uint32_t>(raised)
&
@@ -458,35 +467,23 @@ struct cbl_enabled_exception_t {
struct cbl_declarative_t {
enum { files_max = 16 };
size_t section; // implies program
- uint32_t global; // See the note below
+ bool global;
ec_type_t type;
uint32_t nfile, files[files_max];
cbl_file_mode_t mode;
-/* The ::global member originally was "bool global". A bool, however, occupies
- only one byte of storage. The structure, in turn, is constructed on
- four-byte boundaries for members, so there were three padding bytes between
- the single byte of global and the ::type member.
-
- When used to create a "blob", where the structure was treated as a stream
- of bytes that were used to create a constructor for an array of bytes,
- valgrind noticed that those three padding bytes were not initialized, and
- generated the appropriate error message. This made it hard to find other
- problems.
-
- Changing the declaration from "bool" to "uint32_t" seems to have eliminated
- the valgrind error without affecting overall performance. */
-
- cbl_declarative_t( cbl_file_mode_t mode = file_mode_none_e )
- : section(0), global(false)
+ explicit cbl_declarative_t( cbl_file_mode_t mode = file_mode_none_e )
+ : section(0)
+ , global(false)
, type(ec_none_e)
, nfile(0)
, mode(mode)
{
std::fill(files, files + COUNT_OF(files), 0);
}
- cbl_declarative_t( ec_type_t type )
- : section(0), global(false)
+ explicit cbl_declarative_t( ec_type_t type )
+ : section(0)
+ , global(false)
, type(type)
, nfile(0)
, mode(file_mode_none_e)
@@ -521,10 +518,9 @@ struct cbl_declarative_t {
std::copy( that.files, that.files + nfile, this->files );
}
}
- constexpr cbl_declarative_t& operator=(const cbl_declarative_t&) = default;
+ cbl_declarative_t& operator=(const cbl_declarative_t&) = default;
std::vector<uint64_t> encode() const;
- void decode( const std::vector<uint64_t>& encoded );
/*
* Sort file names before file modes, and file modes before non-IO.
@@ -547,9 +543,9 @@ struct cbl_declarative_t {
return section < that.section;
}
- // TRUE if there are no files to match, or the provided file is in the list.
- bool match_file( size_t file ) const {
- static const auto pend = files + nfile;
+ // TRUE if there are no files to match, or the provided file is in the list.
+ bool match_file( size_t file ) const {
+ static const uint32_t * pend = files + nfile;
return nfile == 0 || pend != std::find(files, files + nfile, file);
}
@@ -578,11 +574,11 @@ class cbl_enabled_exceptions_t : protected std::set<cbl_enabled_exception_t>
public:
cbl_enabled_exceptions_t() {}
- cbl_enabled_exceptions_t( size_t nec, const cbl_enabled_exception_t *ecs )
+ cbl_enabled_exceptions_t( size_t nec, const cbl_enabled_exception_t *ecs )
: std::set<cbl_enabled_exception_t>(ecs, ecs + nec)
{}
void turn_on_off( bool enabled, bool location, ec_type_t type,
- std::set<size_t> files );
+ const std::set<size_t>& files );
const cbl_enabled_exception_t * match( ec_type_t ec, size_t file = 0 ) const;
@@ -601,7 +597,7 @@ class cbl_enabled_exceptions_t : protected std::set<cbl_enabled_exception_t>
cbl_enabled_exceptions_t& operator=( const cbl_enabled_exceptions_t& ) = default;
};
-extern cbl_enabled_exceptions_t enabled_exceptions;
+cbl_enabled_exceptions_t& cdf_enabled_exceptions();
template <typename T>
T enabled_exception_match( T beg, T end, ec_type_t type, size_t file ) {
diff --git a/libgcobol/config.h.in b/libgcobol/config.h.in
index ee3dd6b..1b511d0 100644
--- a/libgcobol/config.h.in
+++ b/libgcobol/config.h.in
@@ -3,6 +3,9 @@
/* Define to 1 if the target assembler supports thread-local storage. */
#undef HAVE_CC_TLS
+/* Define to 1 if you have the `clock_gettime' function. */
+#undef HAVE_CLOCK_GETTIME
+
/* Define to 1 if you have the <complex.h> header file. */
#undef HAVE_COMPLEX_H
diff --git a/libgcobol/configure b/libgcobol/configure
index 5f319ee..7271517 100755
--- a/libgcobol/configure
+++ b/libgcobol/configure
@@ -17275,6 +17275,59 @@ if test "$ac_res" != no; then :
fi
+# Copied from gcc/configure.ac. 2025-06-05 R.J.Dubner
+# At least for glibc, clock_gettime is in librt. But don't pull that
+# in if it still doesn't give us the function we want.
+ac_cv_func_clock_gettime=no
+if test $ac_cv_func_clock_gettime = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clock_gettime in -lrt" >&5
+$as_echo_n "checking for clock_gettime in -lrt... " >&6; }
+if ${ac_cv_lib_rt_clock_gettime+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lrt $LIBS"
+if test x$gcc_no_link = xyes; then
+ as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char clock_gettime ();
+int
+main ()
+{
+return clock_gettime ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_link "$LINENO"; then :
+ ac_cv_lib_rt_clock_gettime=yes
+else
+ ac_cv_lib_rt_clock_gettime=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rt_clock_gettime" >&5
+$as_echo "$ac_cv_lib_rt_clock_gettime" >&6; }
+if test "x$ac_cv_lib_rt_clock_gettime" = xyes; then :
+ LIBS="-lrt $LIBS"
+
+$as_echo "#define HAVE_CLOCK_GETTIME 1" >>confdefs.h
+
+fi
+
+fi
+
have_iec_60559_libc_support=no
if test "x$ac_cv_func_strtof128$ac_cv_func_strfromf128" = xyesyes \
&& test "x$libgcobol_have_sinf128$libgcobol_have_cacosf128" = xyesyes; then
diff --git a/libgcobol/configure.ac b/libgcobol/configure.ac
index 1332696..acfca7e 100644
--- a/libgcobol/configure.ac
+++ b/libgcobol/configure.ac
@@ -232,6 +232,17 @@ AC_SEARCH_LIBS([sinf128], [c m], libgcobol_have_sinf128=yes)
libgcobol_have_cacosf128=no
AC_SEARCH_LIBS([cacosf128], [c m], libgcobol_have_cacosf128=yes)
+# Copied from gcc/configure.ac. 2025-06-05 R.J.Dubner
+# At least for glibc, clock_gettime is in librt. But don't pull that
+# in if it still doesn't give us the function we want.
+ac_cv_func_clock_gettime=no
+if test $ac_cv_func_clock_gettime = no; then
+ AC_CHECK_LIB(rt, clock_gettime,
+ [LIBS="-lrt $LIBS"
+ AC_DEFINE(HAVE_CLOCK_GETTIME, 1,
+ [Define to 1 if you have the `clock_gettime' function.])])
+fi
+
have_iec_60559_libc_support=no
if test "x$ac_cv_func_strtof128$ac_cv_func_strfromf128" = xyesyes \
&& test "x$libgcobol_have_sinf128$libgcobol_have_cacosf128" = xyesyes; then
diff --git a/libgcobol/constants.cc b/libgcobol/constants.cc
index 8c75270..eebfd21 100644
--- a/libgcobol/constants.cc
+++ b/libgcobol/constants.cc
@@ -27,16 +27,19 @@
* (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 <ctype.h>
-#include <errno.h>
+
#include <fcntl.h>
-#include <math.h>
-#include <fenv.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
#include <unistd.h>
+
+#include <cctype>
+#include <cerrno>
+#include <cmath>
+#include <cfenv>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <unordered_map>
#include <vector>
diff --git a/libgcobol/ec.h b/libgcobol/ec.h
index 69d9731..4315d19 100644
--- a/libgcobol/ec.h
+++ b/libgcobol/ec.h
@@ -33,7 +33,6 @@
#define _CBL_EC_H_
#include <set>
-#include <assert.h>
#define EC_ALL_E 0xFFFFFF00
diff --git a/libgcobol/gcobolio.h b/libgcobol/gcobolio.h
index 76d5ab8..2ca8883 100644
--- a/libgcobol/gcobolio.h
+++ b/libgcobol/gcobolio.h
@@ -30,7 +30,8 @@
#ifndef GCOBOLIO_H_
#define GCOBOLIO_H_
-#include <stdio.h>
+#include <cstdio>
+
#include <map>
#include <unordered_map>
#include <vector>
diff --git a/libgcobol/gfileio.cc b/libgcobol/gfileio.cc
index a2ad342..51a73cd 100644
--- a/libgcobol/gfileio.cc
+++ b/libgcobol/gfileio.cc
@@ -27,17 +27,19 @@
* (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 <ctype.h>
-#include <ctype.h>
+
#include <err.h>
-#include <errno.h>
#include <fcntl.h>
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
#include <unistd.h>
+
+#include <cctype>
+#include <cerrno>
+#include <cmath>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <vector>
@@ -189,11 +191,12 @@ handle_errno(cblc_file_t *file, const char *function, const char *msg)
static
char *
-get_filename( cblc_file_t *file,
+get_filename( const cblc_file_t *file,
int is_quoted)
{
static size_t fname_size = MINIMUM_ALLOCATION_SIZE;
- static char *fname = (char *)malloc(MINIMUM_ALLOCATION_SIZE);
+ static char *fname = static_cast<char *>(malloc(MINIMUM_ALLOCATION_SIZE));
+ massert(fname);
fname = internal_to_console(&fname,
&fname_size,
file->filename,
@@ -203,14 +206,15 @@ get_filename( cblc_file_t *file,
{
// We have been given something that might be the name of an
// environment variable that contains the filename:
- char *p_from_environment = getenv(fname);
+ const char *p_from_environment = getenv(fname);
if( p_from_environment )
{
if( strlen(p_from_environment)+1 > fname_size )
{
fname_size = strlen(p_from_environment)+1;
free(fname);
- fname = (char *)malloc(fname_size);
+ fname = static_cast<char *>(malloc(fname_size));
+ massert(fname);
}
strcpy(fname, p_from_environment);
}
@@ -270,7 +274,7 @@ __gg__set_user_status(cblc_field_t *ustatus, cblc_file_t *file)
}
static long
-max_value(cblc_field_t *key)
+max_value(const cblc_field_t *key)
{
long retval;
if( key->digits )
@@ -535,7 +539,8 @@ relative_file_delete_varying(cblc_file_t *file, bool is_random)
size_t payload_length;
- unsigned char *stash = (unsigned char *)malloc(file->default_record->capacity);
+ unsigned char *stash = static_cast<unsigned char *>(malloc(file->default_record->capacity));
+ massert(stash);
memcpy(stash, file->default_record->data, file->default_record->capacity);
long starting_pos = ftell(file->file_pointer);
@@ -652,7 +657,8 @@ relative_file_delete(cblc_file_t *file, bool is_random)
char record_marker;
- unsigned char *stash = (unsigned char *)malloc(file->default_record->capacity);
+ unsigned char *stash = static_cast<unsigned char *>(malloc(file->default_record->capacity));
+ massert(stash);
memcpy(stash, file->default_record->data, file->default_record->capacity);
long starting_pos = ftell(file->file_pointer);
@@ -827,7 +833,7 @@ read_an_indexed_record( cblc_file_t *file,
goto done;
}
- record_length = ach[0]<<8;
+ record_length = static_cast<long>(ach[0])<<8;
record_length += ach[1];
if(ach[2] != 0)
{
@@ -904,7 +910,7 @@ position_state_preserve(cblc_file_t *file, position_state_t &state)
}
static void
-position_state_restore(cblc_file_t *file, position_state_t &state)
+position_state_restore(cblc_file_t *file, const position_state_t &state)
{
file->recent_key = state.recent_key;
fseek(file->file_pointer, state.starting_position, SEEK_SET);
@@ -971,7 +977,8 @@ indexed_file_delete(cblc_file_t *file, bool is_random)
// and the record area itself are unchanged by the delete operation.
// So, we save the current record area:
- stash = (unsigned char *)malloc(file->record_area_max);
+ stash = static_cast<unsigned char *>(malloc(file->record_area_max));
+ massert(stash);
memcpy(stash, file->default_record->data, file->record_area_max);
// And the position state of our file
@@ -1049,8 +1056,6 @@ indexed_file_delete(cblc_file_t *file, bool is_random)
// we find one, we check to see if the keys match. If the keys don't
// match, then we have to remove the existing one from the index.
- std::vector<unsigned char> the_key
- = file_indexed_make_key(file, key_number);
bool deleting = true;
while(deleting)
{
@@ -1067,6 +1072,7 @@ indexed_file_delete(cblc_file_t *file, bool is_random)
deleting = true;
break;
}
+
it++;
}
}
@@ -1232,7 +1238,7 @@ indexed_file_start( cblc_file_t *file,
file->io_status = FsErrno;
}
}
- else if( result < 0 )
+ else // if( result < 0 )
{
// The index is less than the key.
if( relop == lt_op
@@ -1654,7 +1660,7 @@ sequential_file_rewrite( cblc_file_t *file, size_t length )
if( file->record_area_min != file->record_area_max )
{
- unsigned char preamble[4] =
+ const unsigned char preamble[4] =
{
(unsigned char)(bytes_to_write>>8),
(unsigned char)(bytes_to_write),
@@ -1686,7 +1692,6 @@ done:
fseek(file->file_pointer, starting_position, SEEK_SET);
handle_ferror(file, __func__, "fseek() error");
file->prior_op = file_op_rewrite;
- file->prior_op = file_op_rewrite;
establish_status(file, starting_position);
}
@@ -1802,7 +1807,7 @@ relative_file_rewrite_varying( cblc_file_t *file, bool is_random )
done:
// Per the standard, return the file location pointer back to whence it came:
fseek(file->file_pointer, starting_position, SEEK_SET);
- handle_ferror(file, __func__, "fseek() error");
+ handle_ferror(file, __func__, "fseek() error");
file->prior_op = file_op_rewrite;
establish_status(file, starting_position);
}
@@ -1903,7 +1908,7 @@ relative_file_rewrite( cblc_file_t *file, size_t length, bool is_random )
done:
// Per the standard, return the file location pointer back to whence it came:
fseek(file->file_pointer, starting_position, SEEK_SET);
- handle_ferror(file, __func__, "fseek() error");
+ handle_ferror(file, __func__, "fseek() error");
file->prior_op = file_op_rewrite;
establish_status(file, starting_position);
}
@@ -2208,7 +2213,7 @@ __io__file_rewrite(cblc_file_t *file, size_t length, bool is_random)
static void
relative_file_write_varying(cblc_file_t *file,
- unsigned char *location,
+ const unsigned char *location,
size_t length,
bool is_random)
{
@@ -2357,7 +2362,7 @@ done:
static void
relative_file_write(cblc_file_t *file,
- unsigned char *location,
+ const unsigned char *location,
size_t length,
bool is_random)
{
@@ -2372,7 +2377,7 @@ relative_file_write(cblc_file_t *file,
file->io_status = FsErrno;
long necessary_file_size;
- unsigned char achPostamble[] = {internal_cr, internal_newline};
+ const unsigned char achPostamble[] = {internal_cr, internal_newline};
relative_file_parameters rfp;
@@ -2491,7 +2496,7 @@ done:
static void
sequential_file_write(cblc_file_t *file,
- unsigned char *location,
+ const unsigned char *location,
size_t length,
int after,
int lines)
@@ -2607,7 +2612,7 @@ sequential_file_write(cblc_file_t *file,
{
// Because of the min/max mismatch, we require a preamble:
// The first two bytes are the big-endian character count
- unsigned char preamble[4] =
+ const unsigned char preamble[4] =
{
(unsigned char)(characters_to_write>>8),
(unsigned char)(characters_to_write),
@@ -2679,7 +2684,7 @@ done:
static void
indexed_file_write( cblc_file_t *file,
- unsigned char *location,
+ const unsigned char *location,
size_t length,
bool is_random)
{
@@ -2750,13 +2755,13 @@ indexed_file_write( cblc_file_t *file,
// We are allowed to do the write, but only if there will be no key
// violations as a result:
- for(size_t key_number=1;
- key_number<file->supplemental->indexes.size();
- key_number++)
+ for(size_t keynum=1;
+ keynum<file->supplemental->indexes.size();
+ keynum++)
{
- if( file->supplemental->uniques[key_number] )
+ if( file->supplemental->uniques[keynum] )
{
- long record_position = file_indexed_first_position(file, key_number);
+ long record_position = file_indexed_first_position(file, keynum);
if( record_position != -1 )
{
// No can do, because we already have a unique key with that value
@@ -2847,7 +2852,7 @@ done:
static void
__io__file_write( cblc_file_t *file,
- unsigned char *location,
+ const unsigned char *location,
size_t length,
int after,
int lines,
@@ -2981,7 +2986,7 @@ line_sequential_file_read( cblc_file_t *file)
{
break;
}
- if( ch == file->delimiter || ch == EOF )
+ if( ch == EOF )
{
hit_eof = true;
clearerr(file->file_pointer);
@@ -3645,6 +3650,7 @@ indexed_file_read( cblc_file_t *file,
goto done;
}
+ // cppcheck-suppress derefInvalidIteratorRedundantCheck
fpos = file_index->current_iterator->second;
if( file_index->current_iterator == file_index->key_to_position.end() )
@@ -3726,6 +3732,7 @@ indexed_file_read( cblc_file_t *file,
// We are ready to proceed
+ // cppcheck-suppress derefInvalidIteratorRedundantCheck
fpos = file_index->current_iterator->second;
if( file_index->current_iterator == file_index->key_to_position.end() )
{
@@ -3920,7 +3927,6 @@ file_indexed_open(cblc_file_t *file)
{
if( file->key_numbers[index] != current_key_number )
{
- file_index_t file_index;
file->supplemental->indexes.push_back(file_index);
current_key_number = file->key_numbers[index];
file->supplemental->uniques.push_back(file->uniques[index]);
@@ -3950,7 +3956,8 @@ file_indexed_open(cblc_file_t *file)
// We need to open the file for reading, and build the
// maps for each index:
static size_t fname_size = MINIMUM_ALLOCATION_SIZE;
- static char *fname = (char *)malloc(fname_size);
+ static char *fname = static_cast<char *>(malloc(fname_size));
+ massert(fname);
internal_to_console(&fname,
&fname_size,
@@ -3967,7 +3974,8 @@ file_indexed_open(cblc_file_t *file)
}
// Stash the existing record area:
- stash = (unsigned char *)malloc(file->record_area_max);
+ stash = static_cast<unsigned char *>(malloc(file->record_area_max));
+ massert(stash);
memcpy( stash,
file->default_record->data,
file->record_area_max);
@@ -4109,7 +4117,8 @@ __gg__file_reopen(cblc_file_t *file, int mode_char)
}
static size_t fname_size = MINIMUM_ALLOCATION_SIZE;
- static char *fname = (char *)malloc(fname_size);
+ static char *fname = static_cast<char *>(malloc(fname_size));
+ massert(fname)
internal_to_console(&fname,
&fname_size,
file->filename,
@@ -4463,7 +4472,7 @@ public:
typedef void (read_t)( cblc_file_t *file,
int where );
typedef void (write_t)( cblc_file_t *file,
- unsigned char *location,
+ const unsigned char *location,
size_t length,
int after,
int lines,
diff --git a/libgcobol/gmath.cc b/libgcobol/gmath.cc
index 765a282..8a9880b 100644
--- a/libgcobol/gmath.cc
+++ b/libgcobol/gmath.cc
@@ -27,16 +27,19 @@
* (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 <ctype.h>
-#include <errno.h>
+
#include <fcntl.h>
-#include <math.h>
-#include <fenv.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
#include <unistd.h>
+
+#include <cctype>
+#include <cerrno>
+#include <cmath>
+#include <cfenv>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <vector>
@@ -85,7 +88,8 @@ conditional_stash( cblc_field_t *destination,
// This is slightly more complex, because in the event of a
// SIZE ERROR. we need to leave the original value untouched
- unsigned char *stash = (unsigned char *)malloc(destination_s);
+ 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,
@@ -129,7 +133,9 @@ conditional_stash( cblc_field_t *destination,
{
// This is slightly more complex, because in the event of a
// SIZE ERROR. we need to leave the original value untouched
- unsigned char *stash = (unsigned char *)malloc(destination_s);
+ 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,
@@ -253,20 +259,20 @@ __gg__pow( cbl_arith_format_t,
size_t,
size_t,
size_t,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **A = __gg__treeplet_1f;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
- cblc_field_t **B = __gg__treeplet_2f;
- size_t *B_o = __gg__treeplet_2o;
- size_t *B_s = __gg__treeplet_2s;
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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]);
@@ -365,8 +371,8 @@ multiply_int256_by_int64(int256 &product, const uint64_t multiplier)
for(int i=0; i<4; i++)
{
uint128 temp = (uint128)product.i64[i] * multiplier;
- product.i64[i] = *(uint64_t *)(&temp);
- overflows[i+1] = *(uint64_t *)((uint8_t *)(&temp) + 8);
+ 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++)
@@ -383,7 +389,7 @@ multiply_int256_by_int64(int256 &product, const uint64_t multiplier)
}
static int
-add_int256_to_int256(int256 &sum, const int256 addend)
+add_int256_to_int256(int256 &sum, const int256 &addend)
{
uint128 overflows[3] = {};
for(int i=0; i<2; i++)
@@ -448,10 +454,11 @@ divide_int256_by_int64(int256 &val, uint64_t divisor)
for( int i=3; i>=0; i-- )
{
// Left shift temp 64 bits:
- *(uint64_t *)(((uint8_t *)&temp)+8) = *(uint64_t *)(((uint8_t *)&temp)+0);
+ *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
- *(uint64_t *)(((uint8_t *)&temp)+0) = val.i64[i];
+ *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;
@@ -466,7 +473,8 @@ 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.
+ // MAX_FIXED_POINT_DIGITS. If the result does not, we have an OVERFLOW
+ // error.
int is_negative = val.data[31] & 0x80;
if( is_negative )
@@ -474,9 +482,9 @@ squeeze_int256(int256 &val, int &rdigits)
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:
+ // 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);
@@ -501,7 +509,7 @@ squeeze_int256(int256 &val, int &rdigits)
// 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 = *(uint128 *)C1038;
+ static const uint128 biggest = *reinterpret_cast<const uint128 *>(C1038);
// If we still have some rdigits to throw away, we can keep shrinking
// the value:
@@ -537,7 +545,7 @@ squeeze_int256(int256 &val, int &rdigits)
static void
get_int256_from_qualified_field(int256 &var,
int &rdigits,
- cblc_field_t *field,
+ const cblc_field_t *field,
size_t field_o,
size_t field_s)
{
@@ -568,7 +576,7 @@ __gg__add_fixed_phase1( cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
- cbl_round_t *,
+ const cbl_round_t *,
int ,
int *compute_error
)
@@ -577,9 +585,9 @@ __gg__add_fixed_phase1( cbl_arith_format_t ,
// The result goes into the temporary phase1_result.
- cblc_field_t **A = __gg__treeplet_1f;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
+ 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]);
@@ -597,7 +605,6 @@ __gg__add_fixed_phase1( cbl_arith_format_t ,
if( phase1_rdigits > temp_rdigits )
{
scale_int256_by_digits(temp, phase1_rdigits - temp_rdigits);
- temp_rdigits = phase1_rdigits;
}
else if( phase1_rdigits < temp_rdigits )
{
@@ -625,14 +632,14 @@ __gg__addf1_fixed_phase2( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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
@@ -677,7 +684,6 @@ __gg__addf1_fixed_phase2( cbl_arith_format_t ,
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 )
{
@@ -710,16 +716,16 @@ __gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ 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;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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
@@ -768,7 +774,7 @@ __gg__add_float_phase1( cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
- cbl_round_t *,
+ const cbl_round_t *,
int ,
int *compute_error
)
@@ -777,9 +783,9 @@ __gg__add_float_phase1( cbl_arith_format_t ,
// The result goes into the temporary phase1_result_ffloat.
- cblc_field_t **A = __gg__treeplet_1f;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
+ 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]);
@@ -801,14 +807,14 @@ __gg__addf1_float_phase2( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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
@@ -828,14 +834,14 @@ __gg__float_phase2_assign_to_c( cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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
@@ -853,7 +859,7 @@ __gg__addf3(cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
@@ -861,13 +867,13 @@ __gg__addf3(cbl_arith_format_t ,
// 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;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
+ 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;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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);
@@ -903,7 +909,6 @@ __gg__addf3(cbl_arith_format_t ,
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 )
{
@@ -937,14 +942,14 @@ __gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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
@@ -994,7 +999,6 @@ __gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
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
@@ -1022,16 +1026,16 @@ __gg__subtractf2_fixed_phase1(cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ 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;
- size_t *B_o = __gg__treeplet_2o;
- size_t *B_s = __gg__treeplet_2s;
+ 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 ,
@@ -1062,7 +1066,6 @@ __gg__subtractf2_fixed_phase1(cbl_arith_format_t ,
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
@@ -1078,21 +1081,20 @@ __gg__subtractf2_fixed_phase1(cbl_arith_format_t ,
phase1_rdigits = rdigits_b;
}
-
extern "C"
void
__gg__subtractf1_float_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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
@@ -1106,23 +1108,22 @@ __gg__subtractf1_float_phase2(cbl_arith_format_t ,
*rounded++);
}
-
extern "C"
void
__gg__subtractf2_float_phase1(cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ 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;
- size_t *B_o = __gg__treeplet_2o;
- size_t *B_s = __gg__treeplet_2s;
+ 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 ,
@@ -1148,7 +1149,7 @@ __gg__subtractf3( cbl_arith_format_t ,
size_t nA,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
@@ -1156,12 +1157,12 @@ __gg__subtractf3( cbl_arith_format_t ,
// 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;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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);
@@ -1202,7 +1203,6 @@ __gg__subtractf3( cbl_arith_format_t ,
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
@@ -1237,16 +1237,16 @@ __gg__multiplyf1_phase1(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_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;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
+ 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 )
{
@@ -1271,7 +1271,8 @@ void multiply_int128_by_int128(int256 &ABCD,
__int128 ab_value,
__int128 cd_value)
{
- int is_negative = ( ((uint8_t *)(&ab_value))[15]^((uint8_t *)(&cd_value))[15]) & 0x80;
+ int is_negative = ( (PTRCAST(uint8_t, (&ab_value)))[15]
+ ^(PTRCAST(uint8_t, (&cd_value)))[15]) & 0x80;
if( ab_value < 0 )
{
ab_value = -ab_value;
@@ -1287,10 +1288,10 @@ void multiply_int128_by_int128(int256 &ABCD,
uint128 BD;
// Let's extract the digits.
- uint64_t a = *(uint64_t *)((unsigned char *)(&ab_value)+8);
- uint64_t b = *(uint64_t *)((unsigned char *)(&ab_value)+0);
- uint64_t c = *(uint64_t *)((unsigned char *)(&cd_value)+8);
- uint64_t d = *(uint64_t *)((unsigned char *)(&cd_value)+0);
+ 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)
@@ -1331,14 +1332,14 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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;
@@ -1412,14 +1413,13 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
if( error_this_time && on_size_error)
{
*compute_error |= error_this_time;
- rounded++;
}
else
{
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
a_value,
- *rounded++);
+ *rounded);
}
done:
return;
@@ -1431,20 +1431,20 @@ __gg__multiplyf2( cbl_arith_format_t ,
size_t ,
size_t ,
size_t nC,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **A = __gg__treeplet_1f;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
- cblc_field_t **B = __gg__treeplet_2f;
- size_t *B_o = __gg__treeplet_2o;
- size_t *B_s = __gg__treeplet_2s;
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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);
@@ -1514,7 +1514,7 @@ shift_in_place128(uint8_t *buf, int size, int bits)
uint128 temp;
uint128 overflow = 0;
- uint128 *as128 = (uint128 *)buf;
+ uint128 *as128 = PTRCAST(uint128, buf);
for( size_t i=0; i<places; i++ )
{
@@ -1595,7 +1595,7 @@ divide_int128_by_int128(int256 &quotient,
}
// We are going to be referencing the 64-bit pices of the 128-bit divisor:
- uint64_t *divisor64 = (uint64_t *)&divisor;
+ uint64_t *divisor64 = PTRCAST(uint64_t, &divisor);
quotient.i128[1] = 0;
quotient.i128[0] = dividend;
@@ -1664,12 +1664,11 @@ divide_int128_by_int128(int256 &quotient,
int bits_to_shift = 0;
int i=15;
- while( ((uint8_t *)(&divisor))[i] == 0 )
+ while( (PTRCAST(uint8_t, &divisor))[i] == 0 )
{
i -= 1;
bits_to_shift += 8;
- }
- uint8_t tail = ((uint8_t *)(&divisor))[i];
+ } uint8_t tail = ( PTRCAST(uint8_t, &divisor) )[i];
while( !(tail & 0x80) )
{
bits_to_shift += 1;
@@ -1678,9 +1677,8 @@ divide_int128_by_int128(int256 &quotient,
// Shift both the numerator and the divisor that number of bits
- shift_in_place128((uint8_t *)&numerator, sizeof(numerator), bits_to_shift);
- shift_in_place128((uint8_t *)&divisor, sizeof(divisor), bits_to_shift);
-
+ 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
@@ -1697,7 +1695,7 @@ divide_int128_by_int128(int256 &quotient,
// We develop our guess for a quotient by dividing the top two places of
// the numerator area by C
uint128 temp;
- uint64_t *temp64 = (uint64_t *)&temp;
+ uint64_t *temp64 = PTRCAST(uint64_t, &temp);
temp64[1] = numerator.i64[q_place+2];
temp64[0] = numerator.i64[q_place+1];
@@ -1711,10 +1709,10 @@ divide_int128_by_int128(int256 &quotient,
subber[2] = 0;
// Start with the bottom 128 bits of the "subber"
- *(uint128 *)subber = (uint128) divisor64[0] * quotient.i64[q_place];
+ *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];
+ 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];
@@ -1735,20 +1733,20 @@ divide_int128_by_int128(int256 &quotient,
// the numerator:
uint64_t borrow = 0;
- for(size_t i=0; i<3; i++)
+ for(size_t j=0; j<3; j++)
{
- if( numerator.i64[q_place + i] == 0 && borrow )
+ 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 + i] -= subber[i];
+ numerator.i64[q_place + j] -= subber[j];
}
else
{
- uint64_t stash = numerator.i64[q_place + i];
- numerator.i64[q_place + i] -= borrow;
- numerator.i64[q_place + i] -= subber[i];
- if( numerator.i64[q_place + i] > stash )
+ 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
@@ -1772,21 +1770,21 @@ divide_int128_by_int128(int256 &quotient,
{
// We need to add subber back into the numerator area
uint64_t carry = 0;
- for(size_t i=0; i<3; i++)
+ for(size_t ii=0; ii<3; ii++)
{
- if( numerator.i64[q_place + i] == 0xFFFFFFFFFFFFFFFFUL && carry )
+ 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 + i] += subber[i];
+ numerator.i64[q_place + ii] += subber[ii];
}
else
{
// We are not at the top.
- uint64_t stash = numerator.i64[q_place + i];
- numerator.i64[q_place + i] += carry;
- numerator.i64[q_place + i] += subber[i];
- if( numerator.i64[q_place + i] < stash )
+ 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:
@@ -1814,14 +1812,14 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
size_t ,
size_t ,
size_t ,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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;
@@ -1901,14 +1899,13 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
if( error_this_time && on_size_error)
{
- rounded++;
}
else
{
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
b_value,
- *rounded++);
+ *rounded);
}
done:
return;
@@ -1920,20 +1917,20 @@ __gg__dividef23(cbl_arith_format_t ,
size_t ,
size_t ,
size_t nC,
- cbl_round_t *rounded,
+ const cbl_round_t *rounded,
int on_error_flag,
int *compute_error
)
{
- cblc_field_t **A = __gg__treeplet_1f;
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
- cblc_field_t **B = __gg__treeplet_2f;
- size_t *B_o = __gg__treeplet_2o;
- size_t *B_s = __gg__treeplet_2s;
- cblc_field_t **C = __gg__treeplet_3f;
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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;
@@ -2006,15 +2003,15 @@ __gg__dividef45(cbl_arith_format_t ,
int *compute_error
)
{
- cblc_field_t **A = __gg__treeplet_1f; // Numerator
- size_t *A_o = __gg__treeplet_1o;
- size_t *A_s = __gg__treeplet_1s;
- cblc_field_t **B = __gg__treeplet_2f; // Denominator
- size_t *B_o = __gg__treeplet_2o;
- size_t *B_s = __gg__treeplet_2s;
- cblc_field_t **C = __gg__treeplet_3f; // Has remainder, then quotient
- size_t *C_o = __gg__treeplet_3o;
- size_t *C_s = __gg__treeplet_3s;
+ 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;
diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc
index 37ae13e..81ae638 100644
--- a/libgcobol/intrinsic.cc
+++ b/libgcobol/intrinsic.cc
@@ -28,21 +28,21 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-/* Operational note for COBOL intrinsic functions:
-
- In general, the parameters to these functions are cblc_field_t pointers
- along with an offset, size, and for some functions the "allflags", which
- indicate that the variable is a table that was referenced as TABL(ALL)
+/* COBOL intrinsic functions.
+ *
+ * In general, the parameters to these functions are cblc_field_t pointers
+ * along with an offset, size, and for some functions the "allflags", which
+ * indicate that the variable is a table that was referenced as TABL(ALL)
+ */
+#include <langinfo.h>
- */
+#include <cctype>
+#include <cmath>
+#include <cstring>
+#include <ctime>
-#include <time.h>
-#include <math.h>
#include <algorithm>
-#include <cctype>
-#include <langinfo.h>
-#include <string.h>
#include <vector>
#include "config.h"
@@ -167,7 +167,7 @@ JD_to_DOW(double JD)
static
char *
-timespec_to_string(char *retval, struct timespec &tp)
+timespec_to_string(char *retval, struct cbl_timespec &tp)
{
/*
Returns a 21-character string:
@@ -248,9 +248,12 @@ struct input_state
nsubscript = N;
if(N)
{
- subscript_alls = (bool *) malloc(nsubscript);
- subscripts = (size_t *)malloc(nsubscript);
- subscript_limits = (size_t *)malloc(nsubscript);
+ subscript_alls = static_cast<bool *>(malloc(nsubscript));
+ subscripts = static_cast<size_t *>(malloc(nsubscript));
+ subscript_limits = static_cast<size_t *>(malloc(nsubscript));
+ massert(subscript_alls);
+ massert(subscripts);
+ massert(subscript_limits);
}
done = false;
}
@@ -378,7 +381,7 @@ year_to_yyyy(int arg1, int arg2, int arg3)
static
double
-get_value_as_double_from_qualified_field( cblc_field_t *input,
+get_value_as_double_from_qualified_field( const cblc_field_t *input,
size_t input_o,
size_t input_s)
{
@@ -411,9 +414,9 @@ get_value_as_double_from_qualified_field( cblc_field_t *input,
static
GCOB_FP128 kahan_summation(size_t ncount,
cblc_field_t **source,
- size_t *source_o,
- size_t *source_s,
- int *flags,
+ const size_t *source_o,
+ const size_t *source_s,
+ const int *flags,
size_t *k_count)
{
// We use compensated addition. Look up Kahan summation.
@@ -458,9 +461,9 @@ static
GCOB_FP128
variance( size_t ncount,
cblc_field_t **source,
- size_t *source_o,
- size_t *source_s,
- int *flags)
+ const size_t *source_o,
+ const size_t *source_s,
+ const int *flags)
{
// In order to avoid catastrophic cancellation, we are going to use an
// algorithm that is a bit wasteful of time, but is described as particularly
@@ -547,14 +550,14 @@ get_all_time( char *stime,
// days of January show up in the final week of the prior year.
sprintf(stime,
- "%4.4u%2.2u%2.2uT" // YYYYMMSS
- "%2.2u%2.2u%2.2u" // hhmmss
- ".%9.9u" // .sssssssss
- "%c%2.2u%2.2u" // +hhmm
- "W%2.2u" // Www
- "%1u" // DOW [1-7], 1 for Monday
- "%3.3u" // DDD day of year, 001 - 365,366
- "%4.4u", // ZZZZ Year for YYYY-Www-D
+ "%4.4d%2.2d%2.2dT" // YYYYMMSS
+ "%2.2d%2.2d%2.2d" // hhmmss
+ ".%9.9d" // .sssssssss
+ "%c%2.2d%2.2d" // +hhmm
+ "W%2.2d" // Www
+ "%1d" // DOW [1-7], 1 for Monday
+ "%3.3d" // DDD day of year, 001 - 365,366
+ "%4.4d", // ZZZZ Year for YYYY-Www-D
ctm.YYYY,
ctm.MM,
ctm.DD,
@@ -687,7 +690,7 @@ populate_ctm_from_JD(struct cobol_tm &ctm, double JD )
static
void
populate_ctm_from_date( struct cobol_tm &ctm,
- cblc_field_t *pdate,
+ const cblc_field_t *pdate,
size_t pdate_offset,
size_t pdate_size)
{
@@ -721,10 +724,10 @@ populate_ctm_from_double_time(struct cobol_tm &ctm, double time)
static
void
populate_ctm_from_time( struct cobol_tm &ctm,
- cblc_field_t *ptime,
+ const cblc_field_t *ptime,
size_t ptime_o,
size_t ptime_s,
- cblc_field_t *poffset,
+ const cblc_field_t *poffset,
size_t poffset_o,
size_t poffset_s)
{
@@ -791,8 +794,10 @@ convert_to_zulu(cobol_tm &ctm)
static
void
-ftime_replace(char *dest, char const * const dest_end,
- char const *source, char const * const source_end,
+ftime_replace(char *dest,
+ char const * const dest_end,
+ char const * source,
+ char const * const source_end,
char const * const ftime)
{
// This routine is highly dependent on the source format being correct.
@@ -956,7 +961,7 @@ ftime_replace(char *dest, char const * const dest_end,
extern "C"
void
__gg__abs(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -978,7 +983,7 @@ __gg__abs(cblc_field_t *dest,
extern "C"
void
__gg__acos( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1005,10 +1010,10 @@ __gg__acos( cblc_field_t *dest,
extern "C"
void
__gg__annuity(cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_offset,
size_t arg1_size,
- cblc_field_t *arg2,
+ const cblc_field_t *arg2,
size_t arg2_offset,
size_t arg2_size)
{
@@ -1050,7 +1055,7 @@ __gg__annuity(cblc_field_t *dest,
extern "C"
void
__gg__asin( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1080,7 +1085,7 @@ __gg__asin( cblc_field_t *dest,
extern "C"
void
__gg__atan( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1102,7 +1107,7 @@ __gg__atan( cblc_field_t *dest,
extern "C"
void
__gg__byte_length(cblc_field_t *dest,
- cblc_field_t */*source*/,
+ const cblc_field_t */*source*/,
size_t /*source_offset*/,
size_t source_size)
{
@@ -1118,7 +1123,7 @@ __gg__byte_length(cblc_field_t *dest,
extern "C"
void
__gg__char( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1143,10 +1148,10 @@ __gg__char( cblc_field_t *dest,
extern "C"
void
__gg__combined_datetime(cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_offset,
size_t arg1_size,
- cblc_field_t *arg2,
+ const cblc_field_t *arg2,
size_t arg2_offset,
size_t arg2_size)
{
@@ -1192,7 +1197,7 @@ __gg__concat( cblc_field_t *dest,
extern "C"
void
__gg__cos(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1213,8 +1218,8 @@ void
__gg__current_date(cblc_field_t *dest)
{
// FUNCTION CURRENT-DATE
- struct timespec tp = {};
- __gg__clock_gettime(CLOCK_REALTIME, &tp); // time_t tv_sec; long tv_nsec
+ struct cbl_timespec tp = {};
+ __gg__clock_gettime(&tp); // time_t tv_sec; long tv_nsec
char retval[DATE_STRING_BUFFER_SIZE];
timespec_to_string(retval, tp);
@@ -1227,11 +1232,11 @@ void
__gg__seconds_past_midnight(cblc_field_t *dest)
{
// SECONDS-PAST-MIDNIGHT
- struct timespec tp = {};
+ struct cbl_timespec tp = {};
struct tm tm;
__int128 retval=0;
- __gg__clock_gettime(CLOCK_REALTIME, &tp); // time_t tv_sec; long tv_nsec
+ __gg__clock_gettime(&tp); // time_t tv_sec; long tv_nsec
localtime_r(&tp.tv_sec, &tm);
retval += tm.tm_hour;
@@ -1251,7 +1256,7 @@ __gg__seconds_past_midnight(cblc_field_t *dest)
extern "C"
void
__gg__date_of_integer(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1277,13 +1282,13 @@ __gg__date_of_integer(cblc_field_t *dest,
extern "C"
void
__gg__date_to_yyyymmdd( cblc_field_t *dest,
- cblc_field_t *par1,
+ const cblc_field_t *par1,
size_t par1_o,
size_t par1_s,
- cblc_field_t *par2,
+ const cblc_field_t *par2,
size_t par2_o,
size_t par2_s,
- cblc_field_t *par3,
+ const cblc_field_t *par3,
size_t par3_o,
size_t par3_s)
{
@@ -1308,7 +1313,7 @@ __gg__date_to_yyyymmdd( cblc_field_t *dest,
extern "C"
void
__gg__day_of_integer( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1337,13 +1342,13 @@ __gg__day_of_integer( cblc_field_t *dest,
extern "C"
void
__gg__day_to_yyyyddd( cblc_field_t *dest,
- cblc_field_t *par1,
+ const cblc_field_t *par1,
size_t par1_o,
size_t par1_s,
- cblc_field_t *par2,
+ const cblc_field_t *par2,
size_t par2_o,
size_t par2_s,
- cblc_field_t *par3,
+ const cblc_field_t *par3,
size_t par3_o,
size_t par3_s)
{
@@ -1382,7 +1387,7 @@ __gg__e(cblc_field_t *dest)
extern "C"
void
__gg__exp(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1401,7 +1406,7 @@ __gg__exp(cblc_field_t *dest,
extern "C"
void
__gg__exp10(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1420,7 +1425,7 @@ __gg__exp10(cblc_field_t *dest,
extern "C"
void
__gg__factorial(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1451,24 +1456,24 @@ __gg__factorial(cblc_field_t *dest,
extern "C"
void
__gg__formatted_current_date( cblc_field_t *dest, // Destination string
- cblc_field_t *input, // datetime format
+ const cblc_field_t *input, // datetime format
size_t input_offset,
size_t input_size)
{
- // FUNCTION CURRENT-DATE
+ // FUNCTION FORMATTED-CURRENT-DATE
// Establish the destination, and set it to spaces
- char *d = (char *)dest->data;
- char *dend = d + dest->capacity;
+ char *d = PTRCAST(char, dest->data);
+ const char *dend = d + dest->capacity;
memset(d, internal_space, dest->capacity);
// Establish the formatting string:
- char *format = (char *)(input->data+input_offset);
- char *format_end = format + input_size;
+ const char *format = PTRCAST(char, (input->data+input_offset));
+ const char *format_end = format + input_size;
bool is_zulu = false;
- char *p = format;
+ const char *p = format;
while( p < format_end )
{
int ch = *p++;
@@ -1479,8 +1484,8 @@ __gg__formatted_current_date( cblc_field_t *dest, // Destination string
}
}
- struct timespec ts = {};
- __gg__clock_gettime(CLOCK_REALTIME, &ts);
+ struct cbl_timespec ts = {};
+ __gg__clock_gettime(&ts);
struct tm tm = {};
#ifdef HAVE_STRUCT_TM_TM_ZONE
@@ -1512,23 +1517,23 @@ __gg__formatted_current_date( cblc_field_t *dest, // Destination string
extern "C"
void
__gg__formatted_date(cblc_field_t *dest, // Destination string
- cblc_field_t *arg1, // datetime format
+ const cblc_field_t *arg1, // datetime format
size_t arg1_offset,
size_t arg1_size,
- cblc_field_t *arg2, // integer date
+ const cblc_field_t *arg2, // integer date
size_t arg2_offset,
size_t arg2_size)
{
// FUNCTION FORMATTED-DATE
// Establish the destination, and set it to spaces
- char *d = (char *)dest->data;
- char *dend = d + dest->capacity;
+ char *d = PTRCAST(char, dest->data);
+ const char *dend = d + dest->capacity;
memset(d, internal_space, dest->capacity);
// Establish the formatting string:
- char *format = (char *)(arg1->data+arg1_offset);
- char *format_end = format + arg1_size;
+ char *format = PTRCAST(char, (arg1->data+arg1_offset));
+ const char *format_end = format + arg1_size;
struct cobol_tm ctm = {};
@@ -1550,16 +1555,16 @@ __gg__formatted_date(cblc_field_t *dest, // Destination string
extern "C"
void
__gg__formatted_datetime( cblc_field_t *dest, // Destination string
- cblc_field_t *par1, // datetime format
+ const cblc_field_t *par1, // datetime format
size_t par1_o,
size_t par1_s,
- cblc_field_t *par2, // integer date
+ const cblc_field_t *par2, // integer date
size_t par2_o,
size_t par2_s,
- cblc_field_t *par3, // numeric time
+ const cblc_field_t *par3, // numeric time
size_t par3_o,
size_t par3_s,
- cblc_field_t *par4, // optional offset in seconds
+ const cblc_field_t *par4, // optional offset in seconds
size_t par4_o,
size_t par4_s
)
@@ -1567,12 +1572,12 @@ __gg__formatted_datetime( cblc_field_t *dest, // Destination string
// FUNCTION FORMATTED-DATETIME
// Establish the destination, and set it to spaces
- char *d = (char *)dest->data;
- char *dend = d + dest->capacity;
+ char *d = PTRCAST(char, (dest->data));
+ const char *dend = d + dest->capacity;
memset(d, internal_space, dest->capacity);
// Establish the formatting string:
- char *format = (char *)(par1->data+par1_o);
+ char *format = PTRCAST(char, (par1->data+par1_o));
char *format_end = format + par1_s;
trim_trailing_spaces(format, format_end);
bool is_zulu = is_zulu_format(format, format_end);
@@ -1605,13 +1610,13 @@ __gg__formatted_datetime( cblc_field_t *dest, // Destination string
extern "C"
void
__gg__formatted_time( cblc_field_t *dest,// Destination string
- cblc_field_t *par1, // datetime format
+ const cblc_field_t *par1, // datetime format
size_t par1_o,
size_t par1_s,
- cblc_field_t *par2,// numeric time
+ const cblc_field_t *par2,// numeric time
size_t par2_o,
size_t par2_s,
- cblc_field_t *par4, // optional offset in seconds
+ const cblc_field_t *par4, // optional offset in seconds
size_t par4_o,
size_t par4_s)
@@ -1619,12 +1624,12 @@ __gg__formatted_time( cblc_field_t *dest,// Destination string
// FUNCTION FORMATTED-TIME
// Establish the destination, and set it to spaces
- char *d = (char *)dest->data;
- char *dend = d + dest->capacity;
+ char *d = PTRCAST(char, dest->data);
+ const char *dend = d + dest->capacity;
memset(d, internal_space, dest->capacity);
// Establish the formatting string:
- char *format = (char *)(par1->data+par1_o);
+ char *format = PTRCAST(char, (par1->data+par1_o));
char *format_end = format + par1_s;
trim_trailing_spaces(format, format_end);
bool is_zulu = is_zulu_format(format, format_end);
@@ -1659,7 +1664,7 @@ __gg__formatted_time( cblc_field_t *dest,// Destination string
extern "C"
void
__gg__integer(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1677,7 +1682,7 @@ __gg__integer(cblc_field_t *dest,
extern "C"
void
__gg__integer_of_date(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1732,7 +1737,7 @@ __gg__integer_of_date(cblc_field_t *dest,
extern "C"
void
__gg__integer_of_day( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1759,7 +1764,7 @@ __gg__integer_of_day( cblc_field_t *dest,
extern "C"
void
__gg__integer_part( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1782,7 +1787,7 @@ __gg__integer_part( cblc_field_t *dest,
extern "C"
void
__gg__fraction_part(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -1811,10 +1816,10 @@ __gg__fraction_part(cblc_field_t *dest,
extern "C"
void
-__gg__log( cblc_field_t *dest,
- cblc_field_t *source,
- size_t source_offset,
- size_t source_size)
+__gg__log(cblc_field_t *dest,
+ const cblc_field_t *source,
+ size_t source_offset,
+ size_t source_size)
{
// FUNCTION LOG
GCOB_FP128 value = __gg__float128_from_qualified_field(source,
@@ -1836,10 +1841,10 @@ __gg__log( cblc_field_t *dest,
extern "C"
void
-__gg__log10( cblc_field_t *dest,
- cblc_field_t *source,
- size_t source_offset,
- size_t source_size)
+__gg__log10(cblc_field_t *dest,
+ const cblc_field_t *source,
+ size_t source_offset,
+ size_t source_size)
{
// FUNCTION LOG10
GCOB_FP128 value = __gg__float128_from_qualified_field(source,
@@ -1870,8 +1875,8 @@ __gg__max(cblc_field_t *dest,
|| __gg__treeplet_1f[0]->type == FldLiteralA) )
{
cblc_field_t *best_field ;
- unsigned char *best_location ;
- size_t best_length ;
+ unsigned char *best_location = nullptr ;
+ size_t best_length = 0 ;
int best_attr ;
int best_flags ;
@@ -1931,8 +1936,10 @@ __gg__max(cblc_field_t *dest,
}
}
+
__gg__adjust_dest_size(dest, best_length);
dest->type = FldAlphanumeric;
+ assert(best_location);
memcpy(dest->data, best_location, best_length);
}
else
@@ -1977,7 +1984,7 @@ __gg__max(cblc_field_t *dest,
extern "C"
void
__gg__lower_case( cblc_field_t *dest,
- cblc_field_t *input,
+ const cblc_field_t *input,
size_t input_offset,
size_t input_size)
{
@@ -1985,10 +1992,10 @@ __gg__lower_case( cblc_field_t *dest,
size_t source_length = input_size;
memset(dest->data, internal_space, dest_length);
memcpy(dest->data, input->data+input_offset, std::min(dest_length, source_length));
- internal_to_ascii((char *)dest->data, dest_length);
+ internal_to_ascii( PTRCAST(char, dest->data), dest_length);
std::transform(dest->data, dest->data + dest_length, dest->data,
[](unsigned char c) { return std::tolower(c); });
- ascii_to_internal_str((char *)dest->data, dest_length);
+ ascii_to_internal_str( PTRCAST(char, dest->data), dest_length);
}
extern "C"
@@ -2027,7 +2034,8 @@ __gg__median( cblc_field_t *dest,
size_t list_size = 1;
- GCOB_FP128 *the_list = (GCOB_FP128 *)malloc(list_size *sizeof(GCOB_FP128));
+ GCOB_FP128 *the_list = static_cast<GCOB_FP128 *>(malloc(list_size *sizeof(GCOB_FP128)));
+ massert(the_list);
size_t k_count = 0;
assert(ncount);
for(size_t i=0; i<ncount; i++)
@@ -2040,9 +2048,11 @@ __gg__median( cblc_field_t *dest,
if(k_count >= list_size)
{
list_size *= 2;
- the_list = (GCOB_FP128 *)realloc(the_list, list_size *sizeof(GCOB_FP128));
+ the_list = PTRCAST(GCOB_FP128, realloc(the_list, list_size *sizeof(GCOB_FP128)));
+ massert(the_list);
}
+ assert(the_list);
the_list[k_count] = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
__gg__treeplet_1o[i],
__gg__treeplet_1s[i]);
@@ -2125,11 +2135,11 @@ __gg__min(cblc_field_t *dest,
if( ( __gg__treeplet_1f[0]->type == FldAlphanumeric
|| __gg__treeplet_1f[0]->type == FldLiteralA) )
{
- cblc_field_t *best_field ;
- unsigned char *best_location ;
- size_t best_length ;
- int best_attr ;
- int best_flags ;
+ cblc_field_t *best_field ;
+ unsigned char *best_location = nullptr ;
+ size_t best_length = 0 ;
+ int best_attr ;
+ int best_flags ;
bool first_time = true;
assert(ncount);
@@ -2189,6 +2199,7 @@ __gg__min(cblc_field_t *dest,
__gg__adjust_dest_size(dest, best_length);
dest->type = FldAlphanumeric;
+ assert(best_location);
memcpy(dest->data, best_location, best_length);
}
else
@@ -2277,15 +2288,15 @@ __gg__mod(cblc_field_t *dest,
static int
numval( cblc_field_t *dest,
- cblc_field_t *input,
+ const cblc_field_t *input,
size_t input_offset,
size_t input_size)
{
// Returns the one-based character position of a bad character
// returns zero if it is okay
- char *p = (char *)(input->data + input_offset);
- char *pend = p + input_size;
+ const char *p = PTRCAST(char, (input->data + input_offset));
+ const char *pend = p + input_size;
int errpos = 0;
__int128 retval = 0;
@@ -2568,17 +2579,17 @@ numval( cblc_field_t *dest,
static
int
numval_c( cblc_field_t *dest,
- cblc_field_t *src,
+ const cblc_field_t *src,
size_t src_offset,
size_t src_size,
- cblc_field_t *crcy,
+ const cblc_field_t *crcy,
size_t crcy_offset,
size_t crcy_size
)
{
size_t errcode = 0;
- char *pstart = (char *)(src->data+src_offset);
+ char *pstart = PTRCAST(char, (src->data+src_offset));
char *pend = pstart + src_size;
char *p = pstart;
@@ -2593,7 +2604,7 @@ numval_c( cblc_field_t *dest,
char *currency_end;
if( crcy )
{
- currency_start = (char *)(crcy->data+crcy_offset);
+ currency_start = PTRCAST(char, (crcy->data+crcy_offset));
currency_end = currency_start + crcy_size;
}
else
@@ -2807,7 +2818,6 @@ numval_c( cblc_field_t *dest,
if( sign )
{
// A second sign isn't allowed
- state = final_space;
errcode = p - pstart;
p = pend;
}
@@ -2875,7 +2885,7 @@ numval_c( cblc_field_t *dest,
extern "C"
void
__gg__numval( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -2889,7 +2899,7 @@ __gg__numval( cblc_field_t *dest,
extern "C"
void
__gg__test_numval(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -2904,10 +2914,10 @@ __gg__test_numval(cblc_field_t *dest,
extern "C"
void
__gg__numval_c( cblc_field_t *dest,
- cblc_field_t *src,
+ const cblc_field_t *src,
size_t src_offset,
size_t src_size,
- cblc_field_t *crcy,
+ const cblc_field_t *crcy,
size_t crcy_offset,
size_t crcy_size
)
@@ -2924,10 +2934,10 @@ __gg__numval_c( cblc_field_t *dest,
extern "C"
void
__gg__test_numval_c(cblc_field_t *dest,
- cblc_field_t *src,
+ const cblc_field_t *src,
size_t src_offset,
size_t src_size,
- cblc_field_t *crcy,
+ const cblc_field_t *crcy,
size_t crcy_offset,
size_t crcy_size
)
@@ -2949,12 +2959,12 @@ __gg__test_numval_c(cblc_field_t *dest,
extern "C"
void
__gg__ord(cblc_field_t *dest,
- cblc_field_t *input,
+ const cblc_field_t *input,
size_t input_offset,
size_t /*input_size*/)
{
// We get our input in internal_character form.
- char *arg = (char *)(input->data + input_offset);
+ const char *arg = PTRCAST(char, (input->data + input_offset));
// The ORD function takes a single-character string and returns the
// ordinal position of that character.
@@ -3257,10 +3267,10 @@ __gg__range(cblc_field_t *dest,
extern "C"
void
__gg__rem(cblc_field_t *dest,
- cblc_field_t *par1,
+ const cblc_field_t *par1,
size_t par1_offset,
size_t par1_size,
- cblc_field_t *par2,
+ const cblc_field_t *par2,
size_t par2_offset,
size_t par2_size)
{
@@ -3300,10 +3310,10 @@ __gg__rem(cblc_field_t *dest,
extern "C"
void
__gg__trim( cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_offset,
size_t arg1_size,
- cblc_field_t *arg2,
+ const cblc_field_t *arg2,
size_t arg2_offset,
size_t arg2_size)
{
@@ -3329,7 +3339,7 @@ __gg__trim( cblc_field_t *dest,
// No matter what, we want to find the leftmost non-space and the
// rightmost non-space:
- char *left = (char *)(arg1->data+arg1_offset);
+ char *left = PTRCAST(char, (arg1->data+arg1_offset));
char *right = left + arg1_size-1;
// Find left and right: the first and last non-spaces
@@ -3352,13 +3362,13 @@ __gg__trim( cblc_field_t *dest,
{
// We want to leave any trailing spaces, so we return 'right' to its
// original value:
- right = (char *)(arg1->data+arg1_offset) + arg1_size-1;
+ right = PTRCAST(char, (arg1->data+arg1_offset)) + arg1_size-1;
}
else if( type == TRAILING )
{
// We want to leave any leading spaces, so we return 'left' to its
// original value:
- left = (char *)(arg1->data+arg1_offset);
+ left = PTRCAST(char, (arg1->data+arg1_offset));
}
if( left > right )
@@ -3378,9 +3388,9 @@ __gg__trim( cblc_field_t *dest,
// compiler believes the capacity to be at compile-time. But we obviously
// think it'll be okay.
- char *dest_left = (char *)dest->data;
+ char *dest_left = PTRCAST(char, dest->data);
char *dest_right = dest_left + dest->capacity - 1;
- char *dest_end = dest_left + dest->capacity;
+ const char *dest_end = dest_left + dest->capacity;
while( dest_left <= dest_right && left <= right )
{
@@ -3403,7 +3413,7 @@ static unsigned seed = 0;
extern "C"
void
__gg__random( cblc_field_t *dest,
- cblc_field_t *input,
+ const cblc_field_t *input,
size_t input_offset,
size_t input_size)
{
@@ -3422,8 +3432,8 @@ __gg__random( cblc_field_t *dest,
buf->state = NULL;
state = (char *)malloc(state_len);
- struct timespec ts;
- __gg__clock_gettime(CLOCK_REALTIME, &ts);
+ struct cbl_timespec ts;
+ __gg__clock_gettime(&ts);
initstate_r( ts.tv_nsec, state, state_len, buf);
}
int seed = (int)__gg__binary_value_from_qualified_field(&rdigits,
@@ -3462,8 +3472,8 @@ __gg__random_next(cblc_field_t *dest)
buf = (random_data *)malloc(sizeof(struct random_data));
buf->state = NULL;
state = (char *)malloc(state_len);
- struct timespec ts;
- __gg__clock_gettime(CLOCK_REALTIME, &ts);
+ struct cbl_timespec ts;
+ __gg__clock_gettime(&ts);
initstate_r( ts.tv_nsec, state, state_len, buf);
}
random_r(buf, &retval_31);
@@ -3480,7 +3490,7 @@ __gg__random_next(cblc_field_t *dest)
extern "C"
void
__gg__reverse(cblc_field_t *dest,
- cblc_field_t *input,
+ const cblc_field_t *input,
size_t input_offset,
size_t input_size)
{
@@ -3501,7 +3511,7 @@ __gg__reverse(cblc_field_t *dest,
extern "C"
void
__gg__sign( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -3534,7 +3544,7 @@ __gg__sign( cblc_field_t *dest,
extern "C"
void
__gg__sin(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -3555,7 +3565,7 @@ __gg__sin(cblc_field_t *dest,
extern "C"
void
__gg__sqrt( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -3565,7 +3575,7 @@ __gg__sqrt( cblc_field_t *dest,
source_offset,
source_size);
- if( value <= GCOB_FP128_LITERAL(0.0) )
+ if( value < GCOB_FP128_LITERAL(0.0) )
{
exception_raise(ec_argument_function_e);
}
@@ -3621,7 +3631,7 @@ __gg__sum(cblc_field_t *dest,
extern "C"
void
__gg__tan(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -3640,7 +3650,7 @@ __gg__tan(cblc_field_t *dest,
extern "C"
void
__gg__test_date_yyyymmdd( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -3650,14 +3660,8 @@ __gg__test_date_yyyymmdd( cblc_field_t *dest,
source_offset,
source_size);
int retval;
- int dd = yyyymmdd % 100;
int mmdd = yyyymmdd % 10000;
int mm = mmdd / 100;
- int yyyy = yyyymmdd / 10000;
- int jy;
- int jm;
- int jd;
- double JD;
if( yyyymmdd < 16010000 || yyyymmdd > 99999999 )
{
retval = 1;
@@ -3668,6 +3672,13 @@ __gg__test_date_yyyymmdd( cblc_field_t *dest,
}
else
{
+ int dd = yyyymmdd % 100;
+ int yyyy = yyyymmdd / 10000;
+ int jy;
+ int jm;
+ int jd;
+ double JD;
+
// If there is something wrong with the number of days per month for a
// given year, the Julian Date conversion won't reverse properly.
// For example, January 32 will come back as February 1
@@ -3692,7 +3703,7 @@ __gg__test_date_yyyymmdd( cblc_field_t *dest,
extern "C"
void
__gg__test_day_yyyyddd( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
@@ -3730,7 +3741,7 @@ __gg__test_day_yyyyddd( cblc_field_t *dest,
extern "C"
void
__gg__upper_case( cblc_field_t *dest,
- cblc_field_t *input,
+ const cblc_field_t *input,
size_t input_offset,
size_t input_size)
{
@@ -3738,10 +3749,10 @@ __gg__upper_case( cblc_field_t *dest,
size_t source_length = input_size;
memset(dest->data, internal_space, dest_length);
memcpy(dest->data, input->data+input_offset, std::min(dest_length, source_length));
- internal_to_ascii((char *)dest->data, dest_length);
+ internal_to_ascii( PTRCAST(char, dest->data), dest_length);
std::transform(dest->data, dest->data + dest_length, dest->data,
[](unsigned char c) { return std::toupper(c); });
- ascii_to_internal_str((char *)dest->data, dest_length);
+ ascii_to_internal_str( PTRCAST(char, dest->data), dest_length);
}
extern "C"
@@ -3765,7 +3776,7 @@ extern "C"
void
__gg__when_compiled(cblc_field_t *dest, size_t tv_sec, long tv_nsec)
{
- struct timespec tp = {};
+ struct cbl_timespec tp = {};
tp.tv_sec = tv_sec;
tp.tv_nsec = tv_nsec;
char retval[DATE_STRING_BUFFER_SIZE];
@@ -3777,13 +3788,13 @@ __gg__when_compiled(cblc_field_t *dest, size_t tv_sec, long tv_nsec)
extern "C"
void
__gg__year_to_yyyy( cblc_field_t *dest,
- cblc_field_t *par1,
+ const cblc_field_t *par1,
size_t par1_o,
size_t par1_s,
- cblc_field_t *par2,
+ const cblc_field_t *par2,
size_t par2_o,
size_t par2_s,
- cblc_field_t *par3,
+ const cblc_field_t *par3,
size_t par3_o,
size_t par3_s)
{
@@ -3804,7 +3815,7 @@ __gg__year_to_yyyy( cblc_field_t *dest,
static
int
-gets_int(int ndigits, char *p, char *pend, int *digits)
+gets_int(int ndigits, const char *p, const char *pend, int *digits)
{
// This routine returns the value of the integer at p. If there is something
// wrong with the integer, it returns a negative number, the value being the
@@ -3835,7 +3846,7 @@ gets_int(int ndigits, char *p, char *pend, int *digits)
static
int
-gets_year(char *p, char *pend, struct cobol_tm &ctm)
+gets_year(const char *p, const char *pend, struct cobol_tm &ctm)
{
// Populates ctm.YYYY, ctm.days_in_year, and ctm.weeks_in_year, which are
// all determined by the YYYY value.
@@ -3855,10 +3866,6 @@ gets_year(char *p, char *pend, struct cobol_tm &ctm)
{
return 2;
}
- if( digits[0] == 0 && digits[1] < 5)
- {
- return 2;
- }
if( digits[2] == -1 )
{
return 3;
@@ -3903,7 +3910,7 @@ gets_year(char *p, char *pend, struct cobol_tm &ctm)
static
int
-gets_month(char *p, char *pend, struct cobol_tm &ctm)
+gets_month(const char *p, const char *pend, struct cobol_tm &ctm)
{
// Populates ctm.MM
@@ -3950,7 +3957,7 @@ gets_month(char *p, char *pend, struct cobol_tm &ctm)
static
int
-gets_day(char *p, char *pend, struct cobol_tm &ctm)
+gets_day(const char *p, const char *pend, struct cobol_tm &ctm)
{
// Populates ctm.DD, ctm.day_of_week, ctm.week_of_year, ctm.day_of_week
@@ -3968,48 +3975,45 @@ gets_day(char *p, char *pend, struct cobol_tm &ctm)
{
return 2;
}
- if(DD >= 0)
+ if( DD >= 0 )
{
- if( DD >= 0 )
+ if( DD == 0)
{
- if( DD == 0)
- {
- // If zero, we know we failed at the second '0' in "00"
- retval = 2;
- }
- else if( DD >= 40)
+ // If zero, we know we failed at the second '0' in "00"
+ retval = 2;
+ }
+ else if( DD >= 40)
+ {
+ // 40 or more, then we knew there was trouble at the first digit
+ retval = 1;
+ }
+ else if(ctm.MM == 2 && DD >=30)
+ {
+ // It's February, so if we see 3x we know on the 3 that we are in
+ // error:
+ retval = 1;
+ }
+ else
+ {
+ static const int month_days[13] = {-1,31,28,31,30,31,30,31,31,30,31,30,31};
+ int days_in_month = month_days[ctm.MM];
+ if( ctm.MM == 2 && ctm.days_in_year == 366 )
{
- // 40 or more, then we knew there was trouble at the first digit
- retval = 1;
+ days_in_month = 29;
}
- else if(ctm.MM == 2 && DD >=30)
+
+ if( DD > days_in_month )
{
- // It's February, so if we see 3x we know on the 3 that we are in
- // error:
- retval = 1;
+ retval = 2;
}
else
{
- static const int month_days[13] = {-1,31,28,31,30,31,30,31,31,30,31,30,31};
- int days_in_month = month_days[ctm.MM];
- if( ctm.MM == 2 && ctm.days_in_year == 366 )
- {
- days_in_month = 29;
- }
-
- if( DD > days_in_month )
- {
- retval = 2;
- }
- else
- {
- // We have a good YYYY-MM-DD
- ctm.DD = DD;
- double JD = YMD_to_JD(ctm.YYYY, ctm.MM, DD);
- double JD_Jan0 = YMD_to_JD(ctm.YYYY, 1, 0);
- ctm.day_of_year = (int)(JD - JD_Jan0);
- ctm.day_of_week = JD_to_DOW(JD);
- }
+ // We have a good YYYY-MM-DD
+ ctm.DD = DD;
+ double JD = YMD_to_JD(ctm.YYYY, ctm.MM, DD);
+ double JD_Jan0 = YMD_to_JD(ctm.YYYY, 1, 0);
+ ctm.day_of_year = (int)(JD - JD_Jan0);
+ ctm.day_of_week = JD_to_DOW(JD);
}
}
}
@@ -4022,7 +4026,7 @@ gets_day(char *p, char *pend, struct cobol_tm &ctm)
static
int
-gets_day_of_week(char *p, char *pend, struct cobol_tm &ctm)
+gets_day_of_week(const char *p, const char *pend, struct cobol_tm &ctm)
{
// This is just a simple D, for day-of-week. The COBOL spec is that
// it be 1 to 7, 1 being Monday
@@ -4071,7 +4075,7 @@ gets_day_of_week(char *p, char *pend, struct cobol_tm &ctm)
static
int
-gets_day_of_year(char *p, char *pend, struct cobol_tm &ctm)
+gets_day_of_year(const char *p, const char *pend, struct cobol_tm &ctm)
{
// This is a three-digit day-of-year, 001 through 365,366
int digits[3];
@@ -4128,7 +4132,7 @@ gets_day_of_year(char *p, char *pend, struct cobol_tm &ctm)
static
int
-gets_week(char *p, char *pend, struct cobol_tm &ctm)
+gets_week(const char *p, const char *pend, struct cobol_tm &ctm)
{
// This is a two-digit value, 01 through 52,53
int digits[2];
@@ -4168,7 +4172,10 @@ gets_week(char *p, char *pend, struct cobol_tm &ctm)
static
int
-gets_hours(char *p, char *pend, struct cobol_tm &ctm, bool in_offset)
+gets_hours( const char *p,
+ const char *pend,
+ struct cobol_tm &ctm,
+ bool in_offset)
{
// This is a two-digit value, 01 through 23
int digits[2];
@@ -4213,7 +4220,10 @@ gets_hours(char *p, char *pend, struct cobol_tm &ctm, bool in_offset)
static
int
-gets_minutes(char *p, char *pend, struct cobol_tm &ctm, bool in_offset)
+gets_minutes( const char *p,
+ const char *pend,
+ struct cobol_tm &ctm,
+ bool in_offset)
{
// This is a two-digit value, 01 through 59
int digits[2];
@@ -4251,7 +4261,7 @@ gets_minutes(char *p, char *pend, struct cobol_tm &ctm, bool in_offset)
static
int
-gets_seconds(char *p, char *pend, struct cobol_tm &ctm)
+gets_seconds(const char *p, const char *pend, struct cobol_tm &ctm)
{
// This is a two-digit value, 01 through 59
int digits[2];
@@ -4281,7 +4291,11 @@ gets_seconds(char *p, char *pend, struct cobol_tm &ctm)
static
int
-gets_nanoseconds(char *f, char *f_end, char *p, char *pend, struct cobol_tm &ctm)
+gets_nanoseconds( const char *f,
+ const char *f_end,
+ const char *p,
+ const char *pend,
+ struct cobol_tm &ctm)
{
// Because nanoseconds digits to the right of the decimal point can vary from
// one digit to our implementation-specific limit of nine characters, this
@@ -4293,7 +4307,7 @@ gets_nanoseconds(char *f, char *f_end, char *p, char *pend, struct cobol_tm &ctm
int ncount = 0;
int nanoseconds = 0;
- char *pinit = p;
+ const char *pinit = p;
while( f < f_end && *f == internal_s && p < pend )
{
f += 1;
@@ -4325,19 +4339,19 @@ gets_nanoseconds(char *f, char *f_end, char *p, char *pend, struct cobol_tm &ctm
static
int
fill_cobol_tm(cobol_tm &ctm,
- cblc_field_t *par1,
+ const cblc_field_t *par1,
size_t par1_offset,
size_t par1_size,
- cblc_field_t *par2,
+ const cblc_field_t *par2,
size_t par2_offset,
size_t par2_size)
{
// Establish the formatting string:
- char *format = (char *)(par1->data+par1_offset);
+ char *format = PTRCAST(char, (par1->data+par1_offset));
char *format_end = format + par1_size;
// Establish the string to be checked:
- char *source = (char *)(par2->data+par2_offset);
+ char *source = PTRCAST(char, (par2->data+par2_offset));
char *source_end = source + par2_size;
// Let's eliminate trailing spaces...
@@ -4587,10 +4601,10 @@ proceed:
extern "C"
void
__gg__test_formatted_datetime(cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_offset,
size_t arg1_size,
- cblc_field_t *arg2,
+ const cblc_field_t *arg2,
size_t arg2_offset,
size_t arg2_size)
@@ -4610,10 +4624,10 @@ __gg__test_formatted_datetime(cblc_field_t *dest,
extern "C"
void
__gg__integer_of_formatted_date(cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_offset,
size_t arg1_size,
- cblc_field_t *arg2,
+ const cblc_field_t *arg2,
size_t arg2_offset,
size_t arg2_size)
{
@@ -4645,10 +4659,10 @@ __gg__integer_of_formatted_date(cblc_field_t *dest,
extern "C"
void
__gg__seconds_from_formatted_time(cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_offset,
size_t arg1_size,
- cblc_field_t *arg2,
+ const cblc_field_t *arg2,
size_t arg2_offset,
size_t arg2_size)
{
@@ -4673,7 +4687,7 @@ __gg__seconds_from_formatted_time(cblc_field_t *dest,
extern "C"
void
__gg__hex_of(cblc_field_t *dest,
- cblc_field_t *field,
+ const cblc_field_t *field,
size_t field_offset,
size_t field_size)
{
@@ -4691,7 +4705,7 @@ __gg__hex_of(cblc_field_t *dest,
extern "C"
void
__gg__highest_algebraic(cblc_field_t *dest,
- cblc_field_t *var,
+ const cblc_field_t *var,
size_t,
size_t)
{
@@ -4733,7 +4747,7 @@ __gg__highest_algebraic(cblc_field_t *dest,
extern "C"
void
__gg__lowest_algebraic( cblc_field_t *dest,
- cblc_field_t *var,
+ const cblc_field_t *var,
size_t,
size_t)
{
@@ -4795,7 +4809,7 @@ __gg__lowest_algebraic( cblc_field_t *dest,
}
static int
-floating_format_tester(char const * const f, char * const f_end)
+floating_format_tester(char const * const f, char const * const f_end)
{
int retval = -1;
char decimal_point = __gg__get_decimal_point();
@@ -4983,13 +4997,13 @@ floating_format_tester(char const * const f, char * const f_end)
extern "C"
void
__gg__numval_f( cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
GCOB_FP128 value = 0;
- char *data = (char * )(source->data + source_offset);
- char *data_end = data + source_size;
+ const char *data = PTRCAST(char, (source->data + source_offset));
+ const char *data_end = data + source_size;
int error = floating_format_tester(data, data_end);
@@ -5022,12 +5036,12 @@ __gg__numval_f( cblc_field_t *dest,
extern "C"
void
__gg__test_numval_f(cblc_field_t *dest,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size)
{
- char *data = (char * )(source->data + source_offset);
- char *data_end = data + source_size;
+ const char *data = PTRCAST(char, (source->data + source_offset));
+ const char *data_end = data + source_size;
int error = floating_format_tester(data, data_end);
@@ -5039,7 +5053,7 @@ __gg__test_numval_f(cblc_field_t *dest,
}
static bool
-ismatch(char *a1, char *a2, char *b1, char *b2)
+ismatch(const char *a1, const char *a2, const char *b1, const char *b2)
{
bool retval = true;
while( a1 < a2 && b1 < b2 )
@@ -5053,7 +5067,7 @@ ismatch(char *a1, char *a2, char *b1, char *b2)
}
static bool
-iscasematch(char *a1, char *a2, char *b1, char *b2)
+iscasematch(const char *a1, const char *a2, const char *b1, const char *b2)
{
bool retval = true;
while( a1 < a2 && b1 < b2 )
@@ -5066,11 +5080,15 @@ iscasematch(char *a1, char *a2, char *b1, char *b2)
return retval;
}
-static char *
-strstr(char *haystack, char *haystack_e, char *needle, char *needle_e)
+static
+const char *
+strstr( const char *haystack,
+ const char *haystack_e,
+ const char *needle,
+ const char *needle_e)
{
- char *retval = NULL;
- char *pend = haystack_e - (needle_e - needle);
+ const char *retval = NULL;
+ const char *pend = haystack_e - (needle_e - needle);
while( haystack <= pend )
{
if(ismatch(haystack, haystack_e, needle, needle_e))
@@ -5083,11 +5101,15 @@ strstr(char *haystack, char *haystack_e, char *needle, char *needle_e)
return retval;
}
-static char *
-strcasestr(char *haystack, char *haystack_e, char *needle, char *needle_e)
+static
+const char *
+strcasestr( const char *haystack,
+ const char *haystack_e,
+ const char *needle,
+ const char *needle_e)
{
- char *retval = NULL;
- char *pend = haystack_e - (needle_e - needle);
+ const char *retval = NULL;
+ const char *pend = haystack_e - (needle_e - needle);
while( haystack <= pend )
{
if(iscasematch(haystack, haystack_e, needle, needle_e))
@@ -5100,11 +5122,15 @@ strcasestr(char *haystack, char *haystack_e, char *needle, char *needle_e)
return retval;
}
-static char *
-strlaststr(char *haystack, char *haystack_e, char *needle, char *needle_e)
+static
+const char *
+strlaststr( const char *haystack,
+ const char *haystack_e,
+ const char *needle,
+ const char *needle_e)
{
- char *retval = NULL;
- char *pend = haystack_e - (needle_e - needle);
+ const char *retval = NULL;
+ const char *pend = haystack_e - (needle_e - needle);
while( haystack <= pend )
{
if(ismatch(haystack, haystack_e, needle, needle_e))
@@ -5116,11 +5142,15 @@ strlaststr(char *haystack, char *haystack_e, char *needle, char *needle_e)
return retval;
}
-static char *
-strcaselaststr(char *haystack, char *haystack_e, char *needle, char *needle_e)
+static
+const char *
+strcaselaststr( const char *haystack,
+ const char *haystack_e,
+ const char *needle,
+ const char *needle_e)
{
- char *retval = NULL;
- char *pend = haystack_e - (needle_e - needle);
+ const char *retval = NULL;
+ const char *pend = haystack_e - (needle_e - needle);
while( haystack <= pend )
{
if(iscasematch(haystack, haystack_e, needle, needle_e))
@@ -5134,13 +5164,13 @@ strcaselaststr(char *haystack, char *haystack_e, char *needle, char *needle_e)
extern "C"
-void __gg__substitute(cblc_field_t *dest,
- cblc_field_t *arg1_f,
- size_t arg1_o,
- size_t arg1_s,
- size_t N,
- uint8_t *control
- )
+void
+__gg__substitute( cblc_field_t *dest,
+ const cblc_field_t *arg1_f,
+ size_t arg1_o,
+ size_t arg1_s,
+ size_t N,
+ const uint8_t *control)
{
// arg2 is the Group 1 triplet.
// arg3 is the Group 2 triplet
@@ -5148,19 +5178,22 @@ void __gg__substitute(cblc_field_t *dest,
size_t *arg2_o = __gg__treeplet_1o;
size_t *arg2_s = __gg__treeplet_1s;
cblc_field_t **arg3_f = __gg__treeplet_2f;
- size_t *arg3_o = __gg__treeplet_2o;
- size_t *arg3_s = __gg__treeplet_2s;
+ const size_t *arg3_o = __gg__treeplet_2o;
+ const size_t *arg3_s = __gg__treeplet_2s;
- ssize_t retval_size = 256;
- char *retval = (char *)malloc(retval_size);
+ ssize_t retval_size;
+ retval_size = 256;
+ char *retval = static_cast<char *>(malloc(retval_size));
+ massert(retval);
*retval = '\0';
- char *haystack = (char *)(arg1_f->data + arg1_o);
- char *haystack_e = haystack + arg1_s;
+ const char *haystack = PTRCAST(char, (arg1_f->data + arg1_o));
+ const char *haystack_e = haystack + arg1_s;
ssize_t outdex = 0;
- char **pflasts = (char **)malloc(N * sizeof(char *));
+ const char **pflasts = static_cast<const char **>(malloc(N * sizeof(char *)));
+ massert(pflasts);
if( arg1_s == 0 )
{
@@ -5181,15 +5214,15 @@ void __gg__substitute(cblc_field_t *dest,
{
pflasts[i] = strcasestr(haystack,
haystack_e,
- (char *)(arg2_f[i]->data+arg2_o[i]),
- (char *)(arg2_f[i]->data+arg2_o[i]) + arg2_s[i]);
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]);
}
else if( control[i] & substitute_last_e)
{
pflasts[i] = strcaselaststr(haystack,
haystack_e,
- (char *)(arg2_f[i]->data+arg2_o[i]),
- (char *)(arg2_f[i]->data+arg2_o[i]) + arg2_s[i]);
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]);
}
else
{
@@ -5202,15 +5235,15 @@ void __gg__substitute(cblc_field_t *dest,
{
pflasts[i] = strstr(haystack,
haystack_e,
- (char *)(arg2_f[i]->data+arg2_o[i]),
- (char *)(arg2_f[i]->data+arg2_o[i]) + arg2_s[i]);
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]);
}
else if( control[i] & substitute_last_e)
{
pflasts[i] = strlaststr(haystack,
haystack_e,
- (char *)(arg2_f[i]->data+arg2_o[i]),
- (char *)(arg2_f[i]->data+arg2_o[i]) + arg2_s[i]);
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
+ PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]);
}
else
{
@@ -5230,7 +5263,8 @@ void __gg__substitute(cblc_field_t *dest,
> retval_size )
{
retval_size *= 2;
- retval = (char *)realloc(retval, retval_size);
+ retval = static_cast<char *>(realloc(retval, retval_size));
+ massert(retval);
}
// We checked earlier for FIRST/LAST matches
@@ -5245,8 +5279,8 @@ void __gg__substitute(cblc_field_t *dest,
continue;
}
- char *needle = (char *)(arg2_f[i]->data+arg2_o[i]);
- char *needle_e = (char *)(arg2_f[i]->data+arg2_o[i]) + arg2_s[i];
+ const char *needle = PTRCAST(char, arg2_f[i]->data+arg2_o[i]);
+ const char *needle_e = PTRCAST(char, arg2_f[i]->data+arg2_o[i]) + arg2_s[i];
matched = (control[i] & substitute_anycase_e) && iscasematch(
haystack,
haystack_e,
@@ -5274,7 +5308,8 @@ void __gg__substitute(cblc_field_t *dest,
while( outdex + 1 > retval_size )
{
retval_size *= 2;
- retval = (char *)realloc(retval, retval_size);
+ retval = static_cast<char *>(realloc(retval, retval_size));
+ massert(retval);
}
retval[outdex++] = *haystack++;
}
@@ -5291,13 +5326,13 @@ void __gg__substitute(cblc_field_t *dest,
extern "C"
void
__gg__locale_compare( cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_o,
size_t arg1_s,
- cblc_field_t *arg2,
+ const cblc_field_t *arg2,
size_t arg2_o,
size_t arg2_s,
- cblc_field_t *arg_locale,
+ const cblc_field_t *arg_locale,
size_t /*arg_locale_o*/,
size_t /*arg_locale_s*/
)
@@ -5348,10 +5383,10 @@ __gg__locale_compare( cblc_field_t *dest,
extern "C"
void
__gg__locale_date(cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_o,
size_t /*arg1_s*/,
- cblc_field_t *arg_locale,
+ const cblc_field_t *arg_locale,
size_t /*arg_locale_o*/,
size_t /*arg_locale_s*/)
{
@@ -5384,10 +5419,10 @@ __gg__locale_date(cblc_field_t *dest,
extern "C"
void
__gg__locale_time(cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_o,
size_t /*arg1_s*/,
- cblc_field_t *arg_locale,
+ const cblc_field_t *arg_locale,
size_t /*arg_locale_o*/,
size_t /*arg_locale_s*/)
@@ -5420,10 +5455,10 @@ __gg__locale_time(cblc_field_t *dest,
extern "C"
void
__gg__locale_time_from_seconds( cblc_field_t *dest,
- cblc_field_t *arg1,
+ const cblc_field_t *arg1,
size_t arg1_o,
size_t arg1_s,
- cblc_field_t *arg_locale,
+ const cblc_field_t *arg_locale,
size_t /*arg_locale_o*/,
size_t /*arg_locale_s*/)
{
@@ -5439,7 +5474,7 @@ __gg__locale_time_from_seconds( cblc_field_t *dest,
// Default locale
tm tm = {};
- int rdigits;
+ int rdigits=0;
long seconds = (long)__gg__binary_value_from_qualified_field(&rdigits,
arg1,
arg1_o,
diff --git a/libgcobol/io.cc b/libgcobol/io.cc
index 95e1d02..9b07309 100644
--- a/libgcobol/io.cc
+++ b/libgcobol/io.cc
@@ -31,11 +31,12 @@
#include "config.h"
#include "io.h"
-#include "stdio.h"
-#include "stdlib.h"
-#include <errno.h>
-#include <stdbool.h>
-#include <stdint.h>
+
+#include <cstdio>
+#include <cstdlib>
+#include <cerrno>
+#include <cstdbool>
+#include <cstdint>
/*
* The Cobol runtime support is responsible to set the file status
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 2de87cb..c3d78d4 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -29,7 +29,6 @@
*/
#include <algorithm>
#include <cctype>
-#include <cerrno>
#include <cstdio>
#include <cstdlib>
#include <cstring>
@@ -45,11 +44,12 @@
#include <err.h>
#include <fcntl.h>
#include <fenv.h>
-#include <math.h> // required for fpclassify(3)
+#include <math.h> // required for fpclassify(3), not in cmath
#include <setjmp.h>
#include <signal.h>
#include <syslog.h>
#include <unistd.h>
+#include <stdarg.h>
#if __has_include(<errno.h>)
# include <errno.h> // for program_invocation_short_name
#endif
@@ -65,16 +65,19 @@
#include "gfileio.h"
#include "charmaps.h"
#include "valconv.h"
-
#include <sys/mman.h>
#include <sys/resource.h>
#include <sys/stat.h>
#include <sys/types.h>
-
+#include <sys/time.h>
#include <execinfo.h>
-
#include "exceptl.h"
+/* BSD extension. */
+#if !defined(LOG_PERROR)
+#define LOG_PERROR 0
+#endif
+
#if !defined (HAVE_STRFROMF32)
# if __FLT_MANT_DIG__ == 24 && __FLT_MAX_EXP__ == 128
static int
@@ -191,7 +194,7 @@ size_t __gg__unique_prog_id = 0 ;
// location information are established in the "last_exception..." variables.
// This is in accordance with the ISO requirements of "14.6.13.1.1 General" that
// describe how a "last exception status" is maintained.
-// other "location" information
+// other "location" information
static int last_exception_code;
static const char *last_exception_program_id;
static const char *last_exception_section;
@@ -235,36 +238,42 @@ void *__gg__exit_address = NULL;
* 4. handled, where handled == type
*
* If the statement includes some kind of ON ERROR
- * clause that covers it, the generated code does not raise an EC.
+ * clause that covers it, the generated code does not raise an EC.
*
* The status is updated by __gg_match_exception if it runs, else
- * __gg__check_fatal_exception.
+ * __gg__check_fatal_exception.
*
* If a Declarative is matched, its section number is passed to handled_by(),
* which does two things:
* 1. sets isection to record the declarative
* 2. for a nonfatal EC, sets handled, indication no further action is needed
*
- * A Declarative may use RESUME, which clears ec_status, which is a "handled" state.
- *
- * Default processing ensures return to initial state.
+ * A Declarative may use RESUME, which clears ec_status, which is a "handled" state.
+ *
+ * Default processing ensures return to initial state.
*/
class ec_status_t {
public:
struct file_status_t {
- size_t ifile;
- cblc_file_prior_op_t operation;
- cbl_file_mode_t mode;
+ size_t ifile;
+ cblc_file_prior_op_t operation;
+ cbl_file_mode_t mode;
cblc_field_t *user_status;
const char * filename;
- file_status_t() : ifile(0) , operation(file_op_none), mode(file_mode_none_e) {}
- file_status_t( cblc_file_t *file )
- : ifile(file->symbol_table_index)
- , operation(file->prior_op)
- , mode(cbl_file_mode_t(file->mode_char))
- , user_status(file->user_status)
- , filename(file->filename)
- {}
+ file_status_t()
+ : ifile(0)
+ , operation(file_op_none)
+ , mode(file_mode_none_e)
+ , user_status(nullptr)
+ , filename(nullptr)
+ {}
+ explicit file_status_t( const cblc_file_t *file )
+ : ifile(file->symbol_table_index)
+ , operation(file->prior_op)
+ , mode(cbl_file_mode_t(file->mode_char))
+ , user_status(file->user_status)
+ , filename(file->filename)
+ {}
const char * op_str() const {
switch( operation ) {
case file_op_none: return "none";
@@ -279,7 +288,7 @@ class ec_status_t {
return "???";
}
};
- private:
+ private:
char msg[132];
ec_type_t type, handled;
size_t isection;
@@ -287,7 +296,7 @@ class ec_status_t {
cbl_declaratives_t declaratives;
struct file_status_t file;
public:
- size_t lineno;
+ int lineno;
const char *source_file;
cbl_name_t statement; // e.g., "ADD"
@@ -303,28 +312,29 @@ class ec_status_t {
bool is_fatal() const;
ec_status_t& update();
-
+
bool is_enabled() const { return enabled.match(type); }
bool is_enabled( ec_type_t ec) const { return enabled.match(ec); }
ec_status_t& handled_by( size_t declarative_section ) {
isection = declarative_section;
- // A fatal exception remains unhandled unless RESUME clears it.
- if( ! is_fatal() ) {
+ // A fatal exception remains unhandled unless RESUME clears it.
+ if( ! is_fatal() ) {
handled = type;
}
return *this;
}
ec_status_t& clear() {
handled = type = ec_none_e;
- isection = lineno = 0;
+ isection = 0;
+ lineno = 0;
msg[0] = statement[0] = '\0';
return *this;
}
bool unset() const { return isection == 0 && lineno == 0; }
-
+
void reset_environment() const;
ec_status_t& copy_environment();
-
+
// Return the EC's type if it is *not* handled.
ec_type_t unhandled() const {
bool was_handled = ec_cmp(type, handled);
@@ -336,7 +346,7 @@ class ec_status_t {
const file_status_t& file_status() const { return file; }
const char * exception_location() {
- snprintf(msg, sizeof(msg), "%s:%zu: '%s'", source_file, lineno, statement);
+ snprintf(msg, sizeof(msg), "%s:%d: '%s'", source_file, lineno, statement);
return msg;
}
};
@@ -423,8 +433,17 @@ ec_status_t::reset_environment() const {
::declaratives = declaratives;
}
+
+// This is the default truncation mode
static cbl_truncation_mode truncation_mode = trunc_std_e;
+extern "C"
+void
+__gg__set_truncation_mode(cbl_truncation_mode trunc_mode)
+ {
+ truncation_mode = trunc_mode;
+ }
+
struct program_state
{
// These are the run-time values of these characters.
@@ -530,7 +549,6 @@ void *malloc(size_t a)
void *retval = malloc(a);
fprintf(stderr, " --malloc(%p)-- ", retval);
return retval;
- return retval;
}
#endif
@@ -541,6 +559,12 @@ __gg__abort(const char *msg)
abort();
}
+void
+__gg__mabort()
+ {
+ __gg__abort("Memory allocation error\n");
+ }
+
extern "C"
char
__gg__get_decimal_point()
@@ -571,7 +595,7 @@ __gg__resize_int_p( size_t *size,
if( new_size > *size )
{
*size = new_size;
- *block = (int *)realloc(*block, new_size * sizeof(int));
+ *block = static_cast<int *>(realloc(*block, new_size * sizeof(int)));
}
}
@@ -586,36 +610,36 @@ __gg__resize_treeplet(int ngroup,
if( new_size > treeplet_1_size )
{
treeplet_1_size = new_size;
- __gg__treeplet_1f = (cblc_field_t **)realloc(__gg__treeplet_1f, new_size * sizeof(cblc_field_t *));
- __gg__treeplet_1o = (size_t *)realloc(__gg__treeplet_1o, new_size * sizeof(size_t));
- __gg__treeplet_1s = (size_t *)realloc(__gg__treeplet_1s, new_size * sizeof(size_t));
+ __gg__treeplet_1f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_1f, new_size * sizeof(cblc_field_t *)));
+ __gg__treeplet_1o = static_cast<size_t *>(realloc(__gg__treeplet_1o, new_size * sizeof(size_t)));
+ __gg__treeplet_1s = static_cast<size_t *>(realloc(__gg__treeplet_1s, new_size * sizeof(size_t)));
}
break;
case 2:
if( new_size > treeplet_2_size )
{
treeplet_2_size = new_size;
- __gg__treeplet_2f = (cblc_field_t **)realloc(__gg__treeplet_2f, new_size * sizeof(cblc_field_t *));
- __gg__treeplet_2o = (size_t *)realloc(__gg__treeplet_2o, new_size * sizeof(size_t));
- __gg__treeplet_2s = (size_t *)realloc(__gg__treeplet_2s, new_size * sizeof(size_t));
+ __gg__treeplet_2f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_2f, new_size * sizeof(cblc_field_t *)));
+ __gg__treeplet_2o = static_cast<size_t *>(realloc(__gg__treeplet_2o, new_size * sizeof(size_t)));
+ __gg__treeplet_2s = static_cast<size_t *>(realloc(__gg__treeplet_2s, new_size * sizeof(size_t)));
}
break;
case 3:
if( new_size > treeplet_3_size )
{
treeplet_3_size = new_size;
- __gg__treeplet_3f = (cblc_field_t **)realloc(__gg__treeplet_3f, new_size * sizeof(cblc_field_t *));
- __gg__treeplet_3o = (size_t *)realloc(__gg__treeplet_3o, new_size * sizeof(size_t));
- __gg__treeplet_3s = (size_t *)realloc(__gg__treeplet_3s, new_size * sizeof(size_t));
+ __gg__treeplet_3f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_3f, new_size * sizeof(cblc_field_t *)));
+ __gg__treeplet_3o = static_cast<size_t *>(realloc(__gg__treeplet_3o, new_size * sizeof(size_t)));
+ __gg__treeplet_3s = static_cast<size_t *>(realloc(__gg__treeplet_3s, new_size * sizeof(size_t)));
}
break;
case 4:
if( new_size > treeplet_4_size )
{
treeplet_4_size = new_size;
- __gg__treeplet_4f = (cblc_field_t **)realloc(__gg__treeplet_4f, new_size * sizeof(cblc_field_t *));
- __gg__treeplet_4o = (size_t *)realloc(__gg__treeplet_4o, new_size * sizeof(size_t));
- __gg__treeplet_4s = (size_t *)realloc(__gg__treeplet_4s, new_size * sizeof(size_t));
+ __gg__treeplet_4f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_4f, new_size * sizeof(cblc_field_t *)));
+ __gg__treeplet_4o = static_cast<size_t *>(realloc(__gg__treeplet_4o, new_size * sizeof(size_t)));
+ __gg__treeplet_4s = static_cast<size_t *>(realloc(__gg__treeplet_4s, new_size * sizeof(size_t)));
}
break;
}
@@ -733,7 +757,7 @@ __gg__init_program_state()
}
static int
-var_is_refmod( cblc_field_t *var )
+var_is_refmod( const cblc_field_t *var )
{
return (var->attr & refmod_e) != 0;
}
@@ -902,9 +926,9 @@ __gg__binary_to_string_internal(char *result, int digits, __int128 value)
}
static bool
-value_is_too_big( cblc_field_t *var,
- __int128 value,
- int source_rdigits)
+value_is_too_big(const cblc_field_t *var,
+ __int128 value,
+ int source_rdigits)
{
// This routine is in support of arithmetic ON SIZE ERROR. It returns
// TRUE if var hasn't enough bytes to hold the decimal representation
@@ -1041,12 +1065,13 @@ is_sign_bit_on(char ch)
extern "C"
void
-__gg__string_to_alpha_edited_ascii( char *dest,
- char *source,
- int slength,
- char *picture)
+__gg__string_to_alpha_edited_ascii( char *dest,
+ const char *source,
+ int slength,
+ const char *picture)
{
- char *dupe = (char *)malloc(slength);
+ char *dupe = static_cast<char *>(malloc(slength));
+ massert(dupe);
memcpy(dupe, source, slength);
ascii_to_internal_str(dupe, slength);
__gg__string_to_alpha_edited(dest, dupe, slength, picture);
@@ -1401,7 +1426,7 @@ int128_to_field(cblc_field_t *var,
{
float tvalue = (float)value;
tvalue /= (float)__gg__power_of_ten(source_rdigits);
- *(float *)location = tvalue;
+ *PTRCAST(float, location) = tvalue;
break;
}
@@ -1409,7 +1434,7 @@ int128_to_field(cblc_field_t *var,
{
double tvalue = (double)value;
tvalue /= (double)__gg__power_of_ten(source_rdigits);
- *(double *)location = tvalue;
+ *PTRCAST(double, location) = tvalue;
break;
}
@@ -1473,8 +1498,6 @@ int128_to_field(cblc_field_t *var,
default:
{
- bool size_error = false;
-
int target_rdigits = var->rdigits;
if( var->attr & intermediate_e && var->type == FldNumericBin5)
{
@@ -1564,6 +1587,7 @@ int128_to_field(cblc_field_t *var,
else
{
// Value is now scaled to the target's target_rdigits
+ bool size_error = false;
int is_negative = value < 0 ;
@@ -1593,8 +1617,9 @@ int128_to_field(cblc_field_t *var,
// Note that sending a signed value to an alphanumeric strips off
// any plus or minus signs.
- size_error = __gg__binary_to_string_internal( (char *)location,
- length, value);
+ size_error = __gg__binary_to_string_internal(
+ PTRCAST(char, location),
+ length, value);
break;
case FldNumericDisplay:
@@ -1610,7 +1635,7 @@ int128_to_field(cblc_field_t *var,
{
// The sign character goes into the first location
size_error =
- __gg__binary_to_string_internal((char *)(location+1),
+ __gg__binary_to_string_internal(PTRCAST(char, location+1),
length-1, value);
location[0] = sign_ch;
}
@@ -1618,8 +1643,8 @@ int128_to_field(cblc_field_t *var,
{
// The sign character goes into the last location
size_error =
- __gg__binary_to_string_internal( (char *)location,
- length-1, value);
+ __gg__binary_to_string_internal(PTRCAST(char, location),
+ length-1, value);
location[length-1] = sign_ch;
}
}
@@ -1628,7 +1653,7 @@ int128_to_field(cblc_field_t *var,
// The sign information is not separate, so we put it into
// the number
size_error =
- __gg__binary_to_string_internal(( char *)location,
+ __gg__binary_to_string_internal(PTRCAST(char, location),
length, value);
if( size_error && is_negative )
@@ -1664,7 +1689,8 @@ int128_to_field(cblc_field_t *var,
else
{
// It's a simple positive number
- size_error = __gg__binary_to_string_internal( (char *)location,
+ size_error = __gg__binary_to_string_internal( PTRCAST(char,
+ location),
length, value);
}
@@ -1687,12 +1713,12 @@ int128_to_field(cblc_field_t *var,
// Convert that string according to the PICTURE clause
size_error |= __gg__string_to_numeric_edited(
- (char *)location,
+ PTRCAST(char, location),
ach,
target_rdigits,
is_negative,
var->picture);
- ascii_to_internal_str((char *)location, var->capacity);
+ ascii_to_internal_str( PTRCAST(char, location), var->capacity);
}
break;
@@ -1728,7 +1754,7 @@ int128_to_field(cblc_field_t *var,
// Convert that string according to the PICTURE clause
__gg__string_to_alpha_edited(
- (char *)location,
+ PTRCAST(char, location),
ach,
strlen(ach),
var->picture);
@@ -1844,11 +1870,11 @@ int128_to_field(cblc_field_t *var,
}
static __int128
-edited_to_binary( const char *ps_,
+edited_to_binary( char *ps_,
int length,
int *rdigits)
{
- const unsigned char *ps = (const unsigned char *)ps_;
+ const unsigned char *ps = const_cast<const unsigned char *>(PTRCAST(unsigned char, ps_));
// This routine is used for converting NumericEdited strings to
// binary.
@@ -1874,8 +1900,6 @@ edited_to_binary( const char *ps_,
__int128 result = 0;
- unsigned char ch;
-
// We need to check the last two characters. If CR or DB, then the result
// is negative:
if( length >= 2)
@@ -1896,7 +1920,7 @@ edited_to_binary( const char *ps_,
while( index < length )
{
- ch = ps[index++] & 0xFF;
+ unsigned char ch = ps[index++] & 0xFF;
if( ch == ascii_to_internal(__gg__decimal_point) )
{
delta_r = 1;
@@ -1918,11 +1942,7 @@ edited_to_binary( const char *ps_,
}
}
- if( result == 0 )
- {
- hyphen = 0;
- }
- else if( hyphen )
+ if( hyphen )
{
result = -result;
}
@@ -1952,7 +1972,7 @@ big_endian_to_binary_signed(
}
// move the bytes of psource into retval, flipping them end-to-end
- unsigned char *dest = (unsigned char *)&retval;
+ unsigned char *dest = PTRCAST(unsigned char, &retval);
while(capacity > 0)
{
*dest++ = psource[--capacity];
@@ -2016,7 +2036,7 @@ big_endian_to_binary_unsigned(
__int128 retval = 0 ;
// move the bytes of psource into retval, flipping them end-to-end
- unsigned char *dest = (unsigned char *)&retval;
+ unsigned char *dest = PTRCAST(unsigned char, &retval);
while(capacity > 0)
{
*dest++ = psource[--capacity];
@@ -2026,10 +2046,10 @@ big_endian_to_binary_unsigned(
static
__int128
-get_binary_value_local( int *rdigits,
- cblc_field_t *resolved_var,
- unsigned char *resolved_location,
- size_t resolved_length)
+get_binary_value_local( int *rdigits,
+ const cblc_field_t *resolved_var,
+ unsigned char *resolved_location,
+ size_t resolved_length)
{
__int128 retval = 0;
@@ -2050,7 +2070,8 @@ get_binary_value_local( int *rdigits,
case FldGroup :
case FldAlphanumeric :
// Read the data area as a dirty string:
- retval = __gg__dirty_to_binary_internal( (const char *)resolved_location,
+ retval = __gg__dirty_to_binary_internal( PTRCAST(const char,
+ resolved_location),
resolved_length,
rdigits );
break;
@@ -2077,8 +2098,8 @@ get_binary_value_local( int *rdigits,
// Turn all the bits on
memset( &retval, 0xFF, sizeof(retval) );
- // Make it positive
- ((unsigned char *)&retval)[sizeof(retval)-1] = 0x3F;
+ // Make it positive by turning off the highest order bit:
+ (PTRCAST(unsigned char, &retval))[sizeof(retval)-1] = 0x3F;
*rdigits = resolved_var->rdigits;
}
else
@@ -2115,7 +2136,8 @@ get_binary_value_local( int *rdigits,
// We know where the decimal point is because of rdigits. Because
// we know that it a clean string of ASCII digits, we can use the
// dirty converter:
- retval = __gg__dirty_to_binary_internal((const char *)resolved_location,
+ retval = __gg__dirty_to_binary_internal(PTRCAST(const char,
+ resolved_location),
resolved_length,
rdigits );
*rdigits = resolved_var->rdigits;
@@ -2131,7 +2153,7 @@ get_binary_value_local( int *rdigits,
break;
case FldNumericEdited :
- retval = edited_to_binary( (const char *)resolved_location,
+ retval = edited_to_binary( PTRCAST(char, resolved_location),
resolved_length,
rdigits);
break;
@@ -2140,13 +2162,13 @@ get_binary_value_local( int *rdigits,
if( resolved_var->attr & signable_e)
{
retval = big_endian_to_binary_signed(
- (const unsigned char *)resolved_location,
+ PTRCAST(const unsigned char, resolved_location),
resolved_length);
}
else
{
retval = big_endian_to_binary_unsigned(
- (const unsigned char *)resolved_location,
+ PTRCAST(const unsigned char, resolved_location),
resolved_length);
}
*rdigits = resolved_var->rdigits;
@@ -2174,13 +2196,13 @@ get_binary_value_local( int *rdigits,
if( resolved_var->attr & signable_e)
{
retval = little_endian_to_binary_signed(
- (const unsigned char *)resolved_location,
+ PTRCAST(const unsigned char, resolved_location),
resolved_length);
}
else
{
retval = little_endian_to_binary_unsigned(
- (const unsigned char *)resolved_location,
+ PTRCAST(const unsigned char, resolved_location),
resolved_length);
}
*rdigits = resolved_var->rdigits;
@@ -2268,8 +2290,8 @@ get_binary_value_local( int *rdigits,
static time_t
cobol_time()
{
- struct timespec tp;
- __gg__clock_gettime(CLOCK_REALTIME, &tp);
+ struct cbl_timespec tp;
+ __gg__clock_gettime(&tp);
return tp.tv_sec;
}
@@ -2280,7 +2302,7 @@ __gg__get_date_yymmdd()
char ach[32];
time_t t = cobol_time();
- struct tm *local = localtime(&t);
+ const struct tm *local = localtime(&t);
sprintf(ach,
"%2.2d%2.2d%2.2d",
@@ -2299,7 +2321,7 @@ __gg__get_date_yyyymmdd()
char ach[32];
time_t t = cobol_time();
- struct tm *local = localtime(&t);
+ const struct tm *local = localtime(&t);
sprintf(ach,
"%4.4d%2.2d%2.2d",
@@ -2318,7 +2340,7 @@ __gg__get_date_yyddd()
char ach[32];
time_t t = cobol_time();
- struct tm *local = localtime(&t);
+ const struct tm *local = localtime(&t);
sprintf(ach,
"%2.2d%3.3d",
@@ -2336,7 +2358,7 @@ __gg__get_yyyyddd()
char ach[32];
time_t t = cobol_time();
- struct tm *local = localtime(&t);
+ const struct tm *local = localtime(&t);
sprintf(ach,
"%4.4d%3.3d",
@@ -2354,7 +2376,7 @@ __gg__get_date_dow()
char ach[32];
time_t t = cobol_time();
- struct tm *local = localtime(&t);
+ const struct tm *local = localtime(&t);
sprintf(ach,
"%1.1d",
@@ -2381,10 +2403,49 @@ int_from_digits(const char * &p, int ndigits)
return retval;
}
+// For testing purposes, this undef causes the use of gettimeofday().
+// #undef HAVE_CLOCK_GETTIME
+
+static uint64_t
+get_time_nanoseconds_local()
+{
+ // This code was unabashedly stolen from gcc/timevar.cc.
+ // It returns the Unix epoch with nine decimal places.
+
+ /* Note: I am perplexed. I have been examining the gcc Makefiles and
+ configure.ac files, and I am unable to locate where HAVE_GETTIMEOFDAY
+ is established. There have been issues compiling on MacOS, where
+ apparently clock_gettime() is not available. But I don't see exactly
+ how gettimeofday() gets used, instead. But without the ability to
+ compile on a MacOS system, I am fumbling along as best I can.
+
+ I decided to simply replace clock_gettime() with getttimeofday() when
+ clock_gettime() isn't available, even though gcc/timevar.cc handles
+ the situation differently.
+
+ -- Bob Dubner, 2025-06-11*/
+
+ uint64_t retval = 0;
+
+#ifdef HAVE_CLOCK_GETTIME
+ struct timespec ts;
+ clock_gettime (CLOCK_REALTIME, &ts);
+ retval = ts.tv_sec * 1000000000 + ts.tv_nsec;
+ return retval;
+//#endif
+//#ifdef HAVE_GETTIMEOFDAY
+#else
+ struct timeval tv;
+ gettimeofday (&tv, NULL);
+ retval = tv.tv_sec * 1000000000 + tv.tv_usec * 1000;
+ return retval;
+#endif
+ return retval;
+}
extern "C"
void
-__gg__clock_gettime(clockid_t clk_id, struct timespec *tp)
+__gg__clock_gettime(struct cbl_timespec *tp)
{
const char *p = getenv("GCOBOL_CURRENT_DATE");
@@ -2414,7 +2475,9 @@ __gg__clock_gettime(clockid_t clk_id, struct timespec *tp)
}
else
{
- clock_gettime(clk_id, tp);
+ uint64_t ns = get_time_nanoseconds_local();
+ tp->tv_sec = ns/1000000000;
+ tp->tv_nsec = ns%1000000000;
}
}
@@ -2424,8 +2487,8 @@ __gg__get_date_hhmmssff()
{
char ach[32];
- struct timespec tv;
- __gg__clock_gettime(CLOCK_REALTIME, &tv);
+ struct cbl_timespec tv;
+ __gg__clock_gettime(&tv);
struct tm tm;
localtime_r(&tv.tv_sec, &tm);
@@ -2454,20 +2517,19 @@ int
__gg__setop_compare(
const char *candidate,
int capacity,
- const char *domain)
+ char *domain)
{
// This routine is called to compare the characters of 'candidate'
// against the list of character pairs in 'domain'
int retval = 0;
- int ch;
int l;
int h;
- const char *d;
+ char *d;
for(int i=0; i<capacity; i++)
{
- ch = (*candidate++ & 0xFF);
+ int ch = (*candidate++ & 0xFF);
d = domain;
while(*d)
{
@@ -2479,7 +2541,7 @@ __gg__setop_compare(
// See the comments in genapi.cc::get_class_condition_string
// to see how this string was encoded.
- l = (int)strtoll(d, (char **)&d, 16);
+ l = (int)strtoll(d, reinterpret_cast<char **>(&d), 16);
if( l < 0 )
{
l = -l;
@@ -2488,7 +2550,7 @@ __gg__setop_compare(
if( *d == '/' )
{
d += 1;
- h = (int)strtoll(d, (char **)&d, 16);
+ h = (int)strtoll(d, reinterpret_cast<char **>(&d), 16);
if( h < 0 )
{
h = -h;
@@ -2938,7 +3000,7 @@ void psz_to_internal(char *psz)
}
static int
-get_scaled_rdigits(cblc_field_t *field)
+get_scaled_rdigits(const cblc_field_t *field)
{
int retval;
if( !(field->attr & scaled_e) )
@@ -3043,7 +3105,7 @@ format_for_display_internal(char **dest,
break;
}
- unsigned char *running_location = actual_location;
+ const unsigned char *running_location = actual_location;
// We need the counts of digits to the left and right of the decimal point
int rdigits = get_scaled_rdigits(var);
@@ -3058,7 +3120,6 @@ format_for_display_internal(char **dest,
rdigits += ldigits;
}
- int index = 0; // This is the running index into our output destination
if( rdigits )
{
// We need room for the inside decimal point
@@ -3075,6 +3136,7 @@ format_for_display_internal(char **dest,
if( actual_location )
{
+ int index = 0; // This is the running index into our output destination
if( var->attr & signable_e )
{
if( var->attr & separate_e )
@@ -3119,7 +3181,7 @@ format_for_display_internal(char **dest,
// the user.
if( (*dest)[index-1] != (char)DEGENERATE_HIGH_VALUE )
{
- turn_sign_bit_off((unsigned char *)&ch);
+ turn_sign_bit_off( PTRCAST(unsigned char, &ch));
}
(*dest)[index++] = ch;
}
@@ -3143,7 +3205,7 @@ format_for_display_internal(char **dest,
char ch = *running_location++;
if( (*dest)[index-1] != (char)DEGENERATE_HIGH_VALUE )
{
- turn_sign_bit_off((unsigned char *)&ch);
+ turn_sign_bit_off(PTRCAST(unsigned char, &ch));
}
(*dest)[index++] = ch;
}
@@ -3252,11 +3314,9 @@ format_for_display_internal(char **dest,
}
__gg__realloc_if_necessary(dest, dest_size, nsize);
- bool is_signed = value < 0;
-
if( var->attr & signable_e )
{
- if( is_signed )
+ if( value < 0 )
{
(*dest)[index++] = internal_minus;
}
@@ -3288,7 +3348,7 @@ format_for_display_internal(char **dest,
actual_location,
actual_length);
char ach[64];
- sprintf(ach, "%lu", (size_t)value);
+ sprintf(ach, "%lu", (unsigned long)value);
__gg__realloc_if_necessary(dest, dest_size, strlen(ach)+1);
strcpy(*dest, ach);
}
@@ -3344,7 +3404,7 @@ format_for_display_internal(char **dest,
// side, and 9999999 and then 1E+7 on the high side
// 10,000,000 = 1E7
char ach[64];
- _Float32 floatval = *(_Float32 *)actual_location;
+ _Float32 floatval = *PTRCAST(_Float32, actual_location);
strfromf32(ach, sizeof(ach), "%.9E", floatval);
char *p = strchr(ach, 'E');
if( !p )
@@ -3384,7 +3444,7 @@ format_for_display_internal(char **dest,
// We will also format numbers so that we produce 0.01 and 1E-3 on the low
// side, and 9999999 and then 1E+15 on the high side
char ach[64];
- _Float64 floatval = *(_Float64 *)actual_location;
+ _Float64 floatval = *PTRCAST(_Float64, actual_location);
strfromf64(ach, sizeof(ach), "%.17E", floatval);
char *p = strchr(ach, 'E');
if( !p )
@@ -3478,7 +3538,8 @@ format_for_display_internal(char **dest,
if( var->attr & scaled_e && var->type != FldNumericDisplay )
{
static size_t buffer_size = MINIMUM_ALLOCATION_SIZE;
- static char * buffer = (char *)malloc(buffer_size);
+ static char *buffer = static_cast<char *>(malloc(buffer_size));
+ massert(buffer);
if( var->rdigits > 0)
{
// We have something like 123 or +123. We need to insert a decimal
@@ -3537,7 +3598,7 @@ format_for_display_internal(char **dest,
{
p2 += 1;
}
- strcpy((char *)p1, (char *)p2);
+ strcpy(PTRCAST(char, p1), PTRCAST(char, p2));
}
done:
@@ -3586,7 +3647,8 @@ compare_88( const char *list,
{
// We are working with a figurative constant
- test = (char *)malloc(conditional_length);
+ test = static_cast<char *>(malloc(conditional_length));
+ massert(test);
test_len = conditional_length;
// This is where we handle the zero-length strings that
// nonetheless can magically be expanded into figurative
@@ -3623,14 +3685,16 @@ compare_88( const char *list,
else if( list_len < conditional_length )
{
// 'list' is too short; we have to right-fill with spaces:
- test = (char *)malloc(conditional_length);
+ test = static_cast<char *>(malloc(conditional_length));
+ massert(test);
test_len = conditional_length;
memset(test, internal_space, conditional_length);
memcpy(test, list, list_len);
}
else
{
- test = (char *)malloc(list_len);
+ test = static_cast<char *>(malloc(list_len));
+ massert(test);
test_len = list_len;
memcpy(test, list, list_len);
}
@@ -3643,7 +3707,9 @@ compare_88( const char *list,
}
else
{
- cmpval = cstrncmp(test, (char *)conditional_location, conditional_length);
+ cmpval = cstrncmp (test,
+ PTRCAST(char, conditional_location),
+ conditional_length);
if( cmpval == 0 && (int)strlen(test) != conditional_length )
{
// When strncmp returns 0, the actual smaller string is the
@@ -3666,7 +3732,7 @@ compare_88( const char *list,
}
static GCOB_FP128
-get_float128( cblc_field_t *field,
+get_float128( const cblc_field_t *field,
unsigned char *location )
{
GCOB_FP128 retval=0;
@@ -3675,10 +3741,10 @@ get_float128( cblc_field_t *field,
switch( field->capacity )
{
case 4:
- retval = *(_Float32 *)location;
+ retval = *PTRCAST(_Float32 , location);
break;
case 8:
- retval = *(_Float64 *)location;
+ retval = *PTRCAST(_Float64 , location);
break;
case 16:
// retval = *(_Float128 *)location; doesn't work, because the SSE
@@ -3698,12 +3764,13 @@ get_float128( cblc_field_t *field,
{
// We need to replace any commas with periods
static size_t size = 128;
- static char *buffer = (char *)malloc(size);
+ static char *buffer = static_cast<char *>(malloc(size));
while( strlen(field->initial)+1 > size )
{
size *= 2;
- buffer = (char *)malloc(size);
+ buffer = static_cast<char *>(malloc(size));
}
+ massert(buffer);
strcpy(buffer, field->initial);
char *p = strchr(buffer, ',');
if(p)
@@ -3748,7 +3815,7 @@ compare_field_class(cblc_field_t *conditional,
conditional,
conditional_location,
conditional_length);
- char *walker = list->initial;
+ const char *walker = list->initial;
while(*walker)
{
char left_flag;
@@ -3894,8 +3961,8 @@ compare_field_class(cblc_field_t *conditional,
case FldFloat:
{
- GCOB_FP128 value = get_float128(conditional, conditional_location) ;
- char *walker = list->initial;
+ GCOB_FP128 fp128 = get_float128(conditional, conditional_location) ;
+ const char *walker = list->initial;
while(*walker)
{
char left_flag;
@@ -3940,7 +4007,7 @@ compare_field_class(cblc_field_t *conditional,
right_len);
}
- if( left_value <= value && value <= right_value )
+ if( left_value <= fp128 && fp128 <= right_value )
{
retval = 0;
break;
@@ -4020,12 +4087,12 @@ local_is_alpha(int type, bool address_of)
static
int
-compare_strings(char *left_string,
- size_t left_length,
- bool left_all,
- char *right_string,
- size_t right_length,
- bool right_all)
+compare_strings(const char *left_string,
+ size_t left_length,
+ bool left_all,
+ const char *right_string,
+ size_t right_length,
+ bool right_all)
{
int retval = 0;
size_t i = 0;
@@ -4279,6 +4346,7 @@ __gg__compare_2(cblc_field_t *left_side,
retval = 0;
retval = value < 0 ? -1 : retval;
retval = value > 0 ? 1 : retval;
+ compare = true;
break;
}
@@ -4289,6 +4357,7 @@ __gg__compare_2(cblc_field_t *left_side,
retval = 0;
retval = value < 0 ? -1 : retval;
retval = value > 0 ? 1 : retval;
+ compare = true;
break;
}
@@ -4307,9 +4376,7 @@ __gg__compare_2(cblc_field_t *left_side,
compare = true;
break;
}
- compare = true;
goto fixup_retval;
- break;
}
}
}
@@ -4324,10 +4391,10 @@ __gg__compare_2(cblc_field_t *left_side,
if( local_is_alpha(left_side->type, left_address_of)
&& local_is_alpha(right_side->type, right_address_of) )
{
- retval = compare_strings( (char *)left_location,
+ retval = compare_strings( reinterpret_cast<char *>(left_location),
left_length,
left_all,
- (char *)right_location,
+ reinterpret_cast<char *>(right_location),
right_length,
right_all );
@@ -4363,12 +4430,13 @@ __gg__compare_2(cblc_field_t *left_side,
// literal to be the same flavor as the left side:
// We need to replace any commas with periods
static size_t size = 128;
- static char *buffer = (char *)malloc(size);
+ static char *buffer = static_cast<char *>(malloc(size));
while( strlen(right_side->initial)+1 > size )
{
size *= 2;
- buffer = (char *)malloc(size);
+ buffer = static_cast<char *>(malloc(size));
}
+ massert(buffer);
strcpy(buffer, right_side->initial);
if( __gg__decimal_point == ',' )
{
@@ -4386,31 +4454,31 @@ __gg__compare_2(cblc_field_t *left_side,
{
case 4:
{
- _Float32 left_value = *(_Float32 *)left_location;
- _Float32 right_value = strtof(buffer, NULL);
+ _Float32 left_value4 = *PTRCAST(_Float32, left_location);
+ _Float32 right_value4 = strtof(buffer, NULL);
retval = 0;
- retval = left_value < right_value ? -1 : retval;
- retval = left_value > right_value ? 1 : retval;
+ retval = left_value4 < right_value4 ? -1 : retval;
+ retval = left_value4 > right_value4 ? 1 : retval;
break;
}
case 8:
{
- _Float64 left_value = *(_Float64 *)left_location;
- _Float64 right_value = strtod(buffer, NULL);
+ _Float64 left_value8 = *PTRCAST(_Float64, left_location);
+ _Float64 right_value8 = strtod(buffer, NULL);
retval = 0;
- retval = left_value < right_value ? -1 : retval;
- retval = left_value > right_value ? 1 : retval;
+ retval = left_value8 < right_value8 ? -1 : retval;
+ retval = left_value8 > right_value8 ? 1 : retval;
break;
}
case 16:
{
//_Float128 left_value = *(_Float128 *)left_location;
- GCOB_FP128 left_value;
- memcpy(&left_value, left_location, 16);
- GCOB_FP128 right_value = strtofp128(buffer, NULL);
+ GCOB_FP128 left_value16;
+ memcpy(&left_value16, left_location, 16);
+ GCOB_FP128 right_value16 = strtofp128(buffer, NULL);
retval = 0;
- retval = left_value < right_value ? -1 : retval;
- retval = left_value > right_value ? 1 : retval;
+ retval = left_value16 < right_value16 ? -1 : retval;
+ retval = left_value16 > right_value16 ? 1 : retval;
break;
}
}
@@ -4495,10 +4563,10 @@ __gg__compare_2(cblc_field_t *left_side,
if( right_refmod )
{
- retval = compare_strings( (char *)left_location,
+ retval = compare_strings( reinterpret_cast<char *>(left_location),
left_length,
left_all,
- (char *)right_location,
+ reinterpret_cast<char *>(right_location),
right_length,
right_all);
compare = true;
@@ -4516,12 +4584,13 @@ __gg__compare_2(cblc_field_t *left_side,
// VAL5 EQUAL "005" is TRUE
if( left_side->type == FldLiteralA )
{
- left_location = (unsigned char *)left_side->data;
+ left_location = reinterpret_cast<unsigned char *>(left_side->data);
left_length = left_side->capacity;
}
static size_t right_string_size = MINIMUM_ALLOCATION_SIZE;
- static char *right_string = (char *)malloc(right_string_size);
+ static char *right_string
+ = static_cast<char *>(malloc(right_string_size));
right_string = format_for_display_internal(
&right_string,
@@ -4545,7 +4614,7 @@ __gg__compare_2(cblc_field_t *left_side,
left_length -= 1;
}
- char *right_fixed;
+ const char *right_fixed;
if( *right_string == internal_plus || *right_string == internal_minus )
{
right_fixed = right_string + 1;
@@ -4555,7 +4624,7 @@ __gg__compare_2(cblc_field_t *left_side,
right_fixed = right_string;
}
- retval = compare_strings( (char *)left_location,
+ retval = compare_strings( reinterpret_cast<char *>(left_location),
left_length,
left_all,
right_fixed,
@@ -4788,16 +4857,16 @@ sort_contents(unsigned char *contents,
extern "C"
void
-__gg__sort_table( cblc_field_t *table,
- size_t table_o,
- size_t depending_on,
- size_t nkeys,
- cblc_field_t **keys,
- size_t *ascending,
- int duplicates )
+__gg__sort_table( const cblc_field_t *table,
+ size_t table_o,
+ size_t depending_on,
+ size_t nkeys,
+ cblc_field_t **keys,
+ size_t *ascending,
+ int duplicates )
{
size_t buffer_size = 128;
- unsigned char *contents = (unsigned char *)malloc(buffer_size);
+ unsigned char *contents = static_cast<unsigned char *>(malloc(buffer_size));
size_t offset = 0;
std::vector<size_t>offsets;
size_t record_size = table->capacity;
@@ -4809,7 +4878,7 @@ __gg__sort_table( cblc_field_t *table,
while( offset + sizeof(size_t) + record_size > buffer_size )
{
buffer_size *= 2;
- contents = (unsigned char *)realloc(contents, buffer_size);
+ contents = static_cast<unsigned char *>(realloc(contents, buffer_size));
}
offsets.push_back(offset);
memcpy(contents+offset, &record_size, sizeof(size_t));
@@ -4889,7 +4958,7 @@ init_var_both(cblc_field_t *var,
{
//fprintf(stderr, "ABORTING on %2.2d %s %d\n", var->level, var->name, var->type);
//abort();
- var->data = (unsigned char *)malloc(var->capacity);
+ var->data = static_cast<unsigned char *>(malloc(var->capacity));
}
// Set the "initialized" bit, which is tested in parser_symbol_add to make
@@ -4915,11 +4984,11 @@ init_var_both(cblc_field_t *var,
// We need to convert the options to the internal native codeset
size_t buffer_size = 4;
- char *buffer = (char *)malloc(buffer_size);
+ char *buffer = static_cast<char *>(malloc(buffer_size));
size_t index = 0;
- cblc_field_t *parent = var->parent;
+ const cblc_field_t *parent = var->parent;
switch(parent->type)
{
case FldGroup:
@@ -4929,9 +4998,9 @@ init_var_both(cblc_field_t *var,
while(*walker)
{
static size_t first_size = MINIMUM_ALLOCATION_SIZE;
- static char *first = (char *)malloc(first_size);
+ static char *first = static_cast<char *>(malloc(first_size));
static size_t last_size = MINIMUM_ALLOCATION_SIZE;
- static char *last = (char *)malloc(last_size);
+ static char *last = static_cast<char *>(malloc(last_size));
if( (*walker & 0xFF) == 0xFF )
{
strcpy(first, walker);
@@ -4954,7 +5023,7 @@ init_var_both(cblc_field_t *var,
while(index + strlen(first) + strlen(last) + 3 > buffer_size)
{
buffer_size *= 2;
- buffer = (char *)realloc(buffer, buffer_size);
+ buffer = static_cast<char *>(realloc(buffer, buffer_size));
}
strcpy(buffer+index, first);
index += strlen(first) + 1;
@@ -4967,7 +5036,7 @@ init_var_both(cblc_field_t *var,
}
if( index > 0 )
{
- buffer = (char *)realloc(buffer, index);
+ buffer = static_cast<char *>(realloc(buffer, index));
local_initial = buffer;
}
}
@@ -5007,7 +5076,7 @@ init_var_both(cblc_field_t *var,
// memory to the default. But if a parent has been initialized, we must not
// touch our memory:
bool a_parent_initialized = false;
- if( var->data && !explicitly )
+ if( !explicitly )
{
while(parent)
{
@@ -5223,7 +5292,7 @@ init_var_both(cblc_field_t *var,
__gg__abort("Unknown variable type");
}
- char *location = (char *)save_the_location;
+ char *location = reinterpret_cast<char *>(save_the_location);
there_is_more = false;
size_t i=0;
@@ -5249,7 +5318,7 @@ init_var_both(cblc_field_t *var,
}
}
- outer_location = (unsigned char *)location;
+ outer_location = reinterpret_cast<unsigned char *>(location);
} while(there_is_more);
var->data = save_the_location;
@@ -5296,7 +5365,7 @@ alpha_to_alpha_move_from_location(cblc_field_t *field,
// and dest are alphanumeric
dest_length = dest_length ? dest_length : field->capacity;
- char *to = (char *)field->data + dest_offset;
+ char *to = reinterpret_cast<char *>(field->data + dest_offset);
const char *from = source_location;
size_t count = std::min(dest_length, source_length);
@@ -5392,7 +5461,7 @@ static void
alpha_to_alpha_move(cblc_field_t *dest,
size_t dest_offset,
size_t dest_size,
- cblc_field_t *source,
+ const cblc_field_t *source,
size_t source_offset,
size_t source_size,
bool source_move_all)
@@ -5400,7 +5469,7 @@ alpha_to_alpha_move(cblc_field_t *dest,
alpha_to_alpha_move_from_location( dest,
dest_offset,
dest_size,
- (char *)(source->data + source_offset),
+ reinterpret_cast<char *>(source->data + source_offset),
source_size,
source_move_all);
}
@@ -5434,13 +5503,9 @@ __gg__move( cblc_field_t *fdest,
{
int size_error = 0; // This is the return value
- bool moved = true;
-
__int128 value;
int rdigits;
- size_t min_length;
-
cbl_figconst_t source_figconst =
(cbl_figconst_t)(fsource->attr & FIGCONST_MASK);
cbl_field_type_t dest_type = (cbl_field_type_t)fdest->type;
@@ -5484,7 +5549,7 @@ __gg__move( cblc_field_t *fdest,
* standard COBOL and its use should be avoided
*/
- int special_char;
+ int special_char = 0; // quiets cppcheck
if( source_figconst == low_value_e )
{
special_char = ascii_to_internal(__gg__low_value_character);
@@ -5507,6 +5572,8 @@ __gg__move( cblc_field_t *fdest,
}
else
{
+ size_t min_length;
+ bool moved = true;
switch( dest_type )
{
case FldGroup:
@@ -5587,9 +5654,6 @@ __gg__move( cblc_field_t *fdest,
// alphanumeric. We ignore any sign bit, and just
// move the characters:
- int rdigits;
- __int128 value;
-
size_t source_digits
= fsource->digits
+ ( fsource->rdigits < 0
@@ -5755,7 +5819,7 @@ __gg__move( cblc_field_t *fdest,
fsource,
source_offset,
source_size);
- sprintf(ach, "%lu", (size_t)value);
+ sprintf(ach, "%lu", (unsigned long)value);
char *pach = ach;
@@ -5879,31 +5943,31 @@ __gg__move( cblc_field_t *fdest,
{
rdigits = get_scaled_rdigits(fdest);
bool negative = false;
- __int128 value=0;
+ __int128 value128 = 0;
switch(fsource->capacity)
{
case 4:
{
- _Float32 val = *(_Float32 *)(fsource->data+source_offset);
+ _Float32 val = *PTRCAST(_Float32, fsource->data+source_offset);
if(val < 0)
{
negative = true;
val = -val;
}
- val *= (_Float32)__gg__power_of_ten(rdigits);
- value = (__int128)val;
+ val *= static_cast<_Float32>(__gg__power_of_ten(rdigits));
+ value128 = (__int128)val;
break;
}
case 8:
{
- _Float64 val = *(_Float64 *)(fsource->data+source_offset);
+ _Float64 val = *PTRCAST(_Float64, fsource->data+source_offset);
if(val < 0)
{
negative = true;
val = -val;
}
val *= (_Float32)__gg__power_of_ten(rdigits);
- value = (__int128)val;
+ value128 = (__int128)val;
break;
}
case 16:
@@ -5917,19 +5981,19 @@ __gg__move( cblc_field_t *fdest,
val = -val;
}
val *= (_Float32)__gg__power_of_ten(rdigits);
- value = (__int128)val;
+ value128 = (__int128)val;
break;
}
}
if( negative )
{
- value = -value;
+ value128 = -value128;
}
__gg__int128_to_qualified_field(
fdest,
dest_offset,
dest_size,
- value,
+ value128,
rdigits,
rounded,
&size_error );
@@ -5997,30 +6061,30 @@ __gg__move( cblc_field_t *fdest,
// We are converted a floating-point value fixed-point
rdigits = get_scaled_rdigits(fdest);
- GCOB_FP128 value=0;
+ GCOB_FP128 fp128=0;
switch(fsource->capacity)
{
case 4:
{
- value = *(_Float32 *)(fsource->data+source_offset);
+ fp128 = *reinterpret_cast<_Float32 *>(fsource->data+source_offset);
break;
}
case 8:
{
- value = *(_Float64 *)(fsource->data+source_offset);
+ fp128 = *reinterpret_cast<_Float64 *>(fsource->data+source_offset);
break;
}
case 16:
{
// value = *(_Float128 *)(fsource->data+source_offset);
- memcpy(&value, fsource->data+source_offset, 16);
+ memcpy(&fp128, fsource->data+source_offset, 16);
break;
}
}
__gg__float128_to_qualified_field(
fdest,
dest_offset,
- value,
+ fp128,
rounded,
&size_error);
break;
@@ -6051,9 +6115,6 @@ __gg__move( cblc_field_t *fdest,
case FldNumericDisplay:
{
- int rdigits;
- __int128 value;
-
int source_digits = fsource->digits + (fsource->rdigits<0 ? -fsource->rdigits : 0) ;
// Pick up the absolute value of the source
@@ -6074,7 +6135,7 @@ __gg__move( cblc_field_t *fdest,
}
// And move them into place:
- __gg__string_to_alpha_edited( (char *)(fdest->data+dest_offset),
+ __gg__string_to_alpha_edited( reinterpret_cast<char *>(fdest->data+dest_offset),
ach,
source_digits,
fdest->picture);
@@ -6084,7 +6145,7 @@ __gg__move( cblc_field_t *fdest,
default:
{
static size_t display_string_size = MINIMUM_ALLOCATION_SIZE;
- static char *display_string = (char *)malloc(display_string_size);
+ static char *display_string = static_cast<char *>(malloc(display_string_size));
size_t display_string_length = dest_size;
__gg__realloc_if_necessary( &display_string,
@@ -6117,12 +6178,12 @@ __gg__move( cblc_field_t *fdest,
&display_string,
&display_string_size,
fsource,
- (unsigned char *)(fsource->data+source_offset),
+ reinterpret_cast<unsigned char *>(fsource->data+source_offset),
source_size,
source_flags && REFER_T_ADDRESS_OF);
display_string_length = strlen(display_string);
}
- __gg__string_to_alpha_edited( (char *)(fdest->data+dest_offset),
+ __gg__string_to_alpha_edited( reinterpret_cast<char *>(fdest->data+dest_offset),
display_string,
display_string_length,
fdest->picture);
@@ -6147,12 +6208,12 @@ __gg__move( cblc_field_t *fdest,
{
case 4:
{
- *(float *)(fdest->data+dest_offset) = strtof(ach, NULL);
+ *PTRCAST(float, fdest->data+dest_offset) = strtod(ach, NULL);
break;
}
case 8:
{
- *(double *)(fdest->data+dest_offset) = strtod(ach, NULL);
+ *PTRCAST(double, fdest->data+dest_offset) = strtod(ach, NULL);
break;
}
case 16:
@@ -6162,7 +6223,6 @@ __gg__move( cblc_field_t *fdest,
memcpy(fdest->data+dest_offset, &t, 16);
break;
}
- break;
}
break;
}
@@ -6291,7 +6351,7 @@ __gg__move_literala(cblc_field_t *field,
case FldAlphaEdited:
{
static size_t display_string_size = MINIMUM_ALLOCATION_SIZE;
- static char *display_string = (char *)malloc(display_string_size);
+ static char *display_string = static_cast<char *>(malloc(display_string_size));
__gg__realloc_if_necessary( &display_string,
&display_string_size,
@@ -6300,7 +6360,7 @@ __gg__move_literala(cblc_field_t *field,
memset(display_string, internal_space, display_string_size);
size_t len = std::min(display_string_size, strlen);
memcpy(display_string, str, len);
- __gg__string_to_alpha_edited( (char *)(field->data+field_offset),
+ __gg__string_to_alpha_edited( reinterpret_cast<char *>(field->data+field_offset),
display_string,
field_size,
field->picture);
@@ -6317,12 +6377,12 @@ __gg__move_literala(cblc_field_t *field,
{
case 4:
{
- *(float *)(field->data+field_offset) = strtof(ach, NULL);
+ *PTRCAST(float, field->data+field_offset) = strtod(ach, NULL);
break;
}
case 8:
{
- *(double *)(field->data+field_offset) = strtod(ach, NULL);
+ *PTRCAST(double, field->data+field_offset) = strtod(ach, NULL);
break;
}
case 16:
@@ -6331,7 +6391,6 @@ __gg__move_literala(cblc_field_t *field,
memcpy(field->data+field_offset, &t, 16);
break;
}
- break;
}
break;
}
@@ -6452,7 +6511,7 @@ __gg__sort_workfile(cblc_file_t *workfile,
// Read the file into memory
size_t buffer_size = 128;
- unsigned char *contents = (unsigned char *)malloc(buffer_size);
+ unsigned char *contents = static_cast<unsigned char *>(malloc(buffer_size));
size_t offset = 0;
std::vector<size_t>offsets;
size_t bytes_read;
@@ -6482,7 +6541,7 @@ __gg__sort_workfile(cblc_file_t *workfile,
while( offset + sizeof(size_t) + bytes_read > buffer_size )
{
buffer_size *= 2;
- contents = (unsigned char *)realloc(contents, buffer_size);
+ contents = static_cast<unsigned char *>(realloc(contents, buffer_size));
}
offsets.push_back(offset);
@@ -6581,7 +6640,8 @@ __gg__merge_files( cblc_file_t *workfile,
return;
}
- unsigned char *prior_winner = (unsigned char *)malloc(the_biggest);
+ unsigned char *prior_winner = static_cast<unsigned char *>(malloc(the_biggest));
+ massert(prior_winner);
*prior_winner = '\0';
for(;;)
@@ -6761,7 +6821,7 @@ normalize_id( const cblc_field_t *refer,
if( refer )
{
- unsigned char *data = refer->data + refer_o;
+ const unsigned char *data = refer->data + refer_o;
cbl_figconst_t figconst
= (cbl_figconst_t)(refer->attr & FIGCONST_MASK);
@@ -7002,7 +7062,7 @@ the_alpha_and_omega_backward( const normalized_operand &id_before,
static
void
-inspect_backward_format_1(size_t integers[])
+inspect_backward_format_1(const size_t integers[])
{
size_t int_index = 0;
size_t cblc_index = 0;
@@ -7015,9 +7075,9 @@ inspect_backward_format_1(size_t integers[])
std::vector<id_2_result> id_2_results(n_identifier_2);
// Pick up identifier_1, which is the string being inspected
- cblc_field_t *id1 = __gg__treeplet_1f[cblc_index];
- size_t id1_o = __gg__treeplet_1o[cblc_index];
- size_t id1_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id1 = __gg__treeplet_1f[cblc_index];
+ size_t id1_o = __gg__treeplet_1o[cblc_index];
+ size_t id1_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
// normalize it, according to the language specification.
normalized_operand normalized_id_1 = normalize_id(id1, id1_o, id1_s);
@@ -7050,19 +7110,19 @@ inspect_backward_format_1(size_t integers[])
// We are counting characters. There is no identifier-3,
// but we we hard-code the length to one to represent a
// single character.
- comparand next_comparand;
+ comparand next_comparand = {};
next_comparand.id_2_index = i;
next_comparand.operation = operation;
next_comparand.identifier_3.length = 1;
- cblc_field_t *id4_before = __gg__treeplet_1f [cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f [cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
normalized_operand normalized_id_4_before
@@ -7094,23 +7154,23 @@ inspect_backward_format_1(size_t integers[])
for(size_t k=0; k<pair_count; k++)
{
- comparand next_comparand;
+ comparand next_comparand = {};
next_comparand.id_2_index = i;
next_comparand.operation = operation;
- cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
- size_t id3_o = __gg__treeplet_1o[cblc_index];
- size_t id3_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
+ size_t id3_o = __gg__treeplet_1o[cblc_index];
+ size_t id3_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
next_comparand.identifier_3
@@ -7351,9 +7411,9 @@ __gg__inspect_format_1(int backward, size_t integers[])
std::vector<id_2_result> id_2_results(n_identifier_2);
// Pick up identifier_1, which is the string being inspected
- cblc_field_t *id1 = __gg__treeplet_1f[cblc_index];
- size_t id1_o = __gg__treeplet_1o[cblc_index];
- size_t id1_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id1 = __gg__treeplet_1f[cblc_index];
+ size_t id1_o = __gg__treeplet_1o[cblc_index];
+ size_t id1_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
// normalize it, according to the language specification.
normalized_operand normalized_id_1
@@ -7387,19 +7447,19 @@ __gg__inspect_format_1(int backward, size_t integers[])
// We are counting characters. There is no identifier-3,
// but we we hard-code the length to one to represent a
// single character.
- comparand next_comparand;
+ comparand next_comparand = {};
next_comparand.id_2_index = i;
next_comparand.operation = operation;
next_comparand.identifier_3.length = 1;
- cblc_field_t *id4_before = __gg__treeplet_1f [cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f [cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
normalized_operand normalized_id_4_before
@@ -7431,23 +7491,23 @@ __gg__inspect_format_1(int backward, size_t integers[])
for(size_t k=0; k<pair_count; k++)
{
- comparand next_comparand;
+ comparand next_comparand = {};
next_comparand.id_2_index = i;
next_comparand.operation = operation;
- cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
- size_t id3_o = __gg__treeplet_1o[cblc_index];
- size_t id3_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
+ size_t id3_o = __gg__treeplet_1o[cblc_index];
+ size_t id3_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
next_comparand.identifier_3
@@ -7676,7 +7736,7 @@ __gg__inspect_format_1(int backward, size_t integers[])
static
void
-inspect_backward_format_2(size_t integers[])
+inspect_backward_format_2(const size_t integers[])
{
size_t int_index = 0;
size_t cblc_index = 0;
@@ -7706,22 +7766,22 @@ inspect_backward_format_2(size_t integers[])
{
case bound_characters_e:
{
- comparand next_comparand;
+ comparand next_comparand = {};
next_comparand.operation = operation;
- cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
- size_t id5_o = __gg__treeplet_1o[cblc_index];
- size_t id5_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
+ size_t id5_o = __gg__treeplet_1o[cblc_index];
+ size_t id5_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
next_comparand.identifier_5
@@ -7757,27 +7817,27 @@ inspect_backward_format_2(size_t integers[])
for(size_t k=0; k<pair_count; k++)
{
- comparand next_comparand;
+ comparand next_comparand = {};
next_comparand.operation = operation;
- cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
- size_t id3_o = __gg__treeplet_1o[cblc_index];
- size_t id3_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
+ size_t id3_o = __gg__treeplet_1o[cblc_index];
+ size_t id3_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
- size_t id5_o = __gg__treeplet_1o[cblc_index];
- size_t id5_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
+ size_t id5_o = __gg__treeplet_1o[cblc_index];
+ size_t id5_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
next_comparand.identifier_3 = normalize_id(id3, id3_o, id3_s);
@@ -8054,22 +8114,22 @@ __gg__inspect_format_2(int backward, size_t integers[])
{
case bound_characters_e:
{
- comparand next_comparand;
+ comparand next_comparand = {} ;
next_comparand.operation = operation;
- cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
- size_t id5_o = __gg__treeplet_1o[cblc_index];
- size_t id5_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
+ size_t id5_o = __gg__treeplet_1o[cblc_index];
+ size_t id5_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f [cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
next_comparand.identifier_5
@@ -8105,27 +8165,27 @@ __gg__inspect_format_2(int backward, size_t integers[])
for(size_t k=0; k<pair_count; k++)
{
- comparand next_comparand;
+ comparand next_comparand = {};
next_comparand.operation = operation;
- cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
- size_t id3_o = __gg__treeplet_1o[cblc_index];
- size_t id3_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id3 = __gg__treeplet_1f[cblc_index];
+ size_t id3_o = __gg__treeplet_1o[cblc_index];
+ size_t id3_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
- size_t id5_o = __gg__treeplet_1o[cblc_index];
- size_t id5_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id5 = __gg__treeplet_1f[cblc_index];
+ size_t id5_o = __gg__treeplet_1o[cblc_index];
+ size_t id5_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
- size_t id4_before_o = __gg__treeplet_1o[cblc_index];
- size_t id4_before_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_before = __gg__treeplet_1f[cblc_index];
+ size_t id4_before_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_before_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
- cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
- size_t id4_after_o = __gg__treeplet_1o[cblc_index];
- size_t id4_after_s = __gg__treeplet_1s[cblc_index];
+ const cblc_field_t *id4_after = __gg__treeplet_1f[cblc_index];
+ size_t id4_after_o = __gg__treeplet_1o[cblc_index];
+ size_t id4_after_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1;
next_comparand.identifier_3 = normalize_id(id3, id3_o, id3_s);
@@ -8400,12 +8460,12 @@ __gg__inspect_format_4( int backward,
static size_t psz_before_size = MINIMUM_ALLOCATION_SIZE;
static size_t psz_figstring_size = MINIMUM_ALLOCATION_SIZE;
- static char *psz_input = (char *)malloc(psz_input_size );
- static char *psz_original = (char *)malloc(psz_original_size );
- static char *psz_replacement = (char *)malloc(psz_replacement_size);
- static char *psz_after = (char *)malloc(psz_after_size );
- static char *psz_before = (char *)malloc(psz_before_size );
- static char *psz_figstring = (char *)malloc(psz_figstring_size );
+ static char *psz_input = static_cast<char *>(malloc(psz_input_size ));
+ static char *psz_original = static_cast<char *>(malloc(psz_original_size ));
+ static char *psz_replacement = static_cast<char *>(malloc(psz_replacement_size));
+ static char *psz_after = static_cast<char *>(malloc(psz_after_size ));
+ static char *psz_before = static_cast<char *>(malloc(psz_before_size ));
+ static char *psz_figstring = static_cast<char *>(malloc(psz_figstring_size ));
bool all = replacement_size == (size_t)(-1LL);
if( all )
@@ -8499,7 +8559,7 @@ __gg__inspect_format_4( int backward,
}
char *pstart = NULL;
- char *pend = NULL;
+ const char *pend = NULL;
if( backward )
{
if( strlen(psz_before) )
@@ -8592,7 +8652,7 @@ move_string(cblc_field_t *field,
case FldAlphanumeric:
case FldAlphaEdited:
{
- char *to = (char *)(field->data + offset);
+ char *to = reinterpret_cast<char *>(field->data + offset);
size_t dest_length = length ? length : field->capacity;
size_t source_length = strlen_from;
size_t count = std::min(dest_length, source_length);
@@ -8701,7 +8761,7 @@ brute_force_trim(char *str)
extern "C"
int
-__gg__string(size_t integers[])
+__gg__string(const size_t integers[])
{
// The first integer is the count of identifier-2 values. Call it N
// The following N integers are the counts of each of the identifier-1 values,
@@ -8715,12 +8775,11 @@ __gg__string(size_t integers[])
// And so on
cblc_field_t **ref = __gg__treeplet_1f;
- size_t *ref_o = __gg__treeplet_1o;
- size_t *ref_s = __gg__treeplet_1s;
+ const size_t *ref_o = __gg__treeplet_1o;
+ const size_t *ref_s = __gg__treeplet_1s;
static const int INDEX_OF_POINTER = 1;
- size_t index_int = 0;
size_t index_cblc = 0 ;
char figlow[2] = {ascii_to_internal(__gg__low_value_character), 0x00};
@@ -8738,15 +8797,13 @@ __gg__string(size_t integers[])
fighigh[0] = ascii_to_internal(__gg__high_value_character);
}
- // Pick up the number of identifier-2 values
- size_t N = integers[index_int++];
// Pick up the target
- cblc_field_t *tgt = ref[index_cblc];
- size_t tgt_o = ref_o[index_cblc];
- size_t tgt_s = ref_s[index_cblc];
+ const cblc_field_t *tgt = ref[index_cblc];
+ size_t tgt_o = ref_o[index_cblc];
+ size_t tgt_s = ref_s[index_cblc];
index_cblc += 1;
- char *dest = (char *)(tgt->data + tgt_o);
+ char *dest = reinterpret_cast<char *>(tgt->data + tgt_o);
ssize_t dest_length = tgt_s;
// Skip over the index of POINTER:
@@ -8773,18 +8830,23 @@ __gg__string(size_t integers[])
{
// We are go for looping through identifier-2 values:
+ size_t index_int = 0;
+
+ // Pick up the number of identifier-2 values
+ size_t N = integers[index_int++];
+
for( size_t i=0; i<N; i++ )
{
size_t M = integers[index_int++];
// Pick up the identifier_2 DELIMITED BY value
- cblc_field_t *id2 = ref[index_cblc];
- size_t id2_o = ref_o[index_cblc];
- size_t id2_s = ref_s[index_cblc];
+ const cblc_field_t *id2 = ref[index_cblc];
+ size_t id2_o = ref_o[index_cblc];
+ size_t id2_s = ref_s[index_cblc];
index_cblc += 1;
char *piece;
- char *piece_end;
+ const char *piece_end;
cbl_figconst_t figconst = (cbl_figconst_t) ( id2
? (id2->attr & FIGCONST_MASK)
: 0 );
@@ -8811,24 +8873,24 @@ __gg__string(size_t integers[])
piece_end = piece + 1;
break;
default:
- piece = id2 ? (char *)(id2->data + id2_o) : NULL;
+ piece = id2 ? reinterpret_cast<char *>(id2->data + id2_o) : NULL;
piece_end = id2 ? piece + id2_s : NULL;
break;
}
- for(size_t i=0; i<M; i++)
+ for(size_t j=0; j<M; j++)
{
// Pick up the next identifier-1 source string:
- cblc_field_t *id1 = ref[index_cblc];
+ const cblc_field_t *id1 = ref[index_cblc];
size_t id1_o = ref_o[index_cblc];
size_t id1_s = ref_s[index_cblc];
index_cblc += 1;
- const char *whole = id1 ? (const char *)(id1->data + id1_o): NULL ;
+ const char *whole = id1 ? reinterpret_cast<char *>(id1->data + id1_o): NULL ;
const char *whole_end = id1 ? whole + id1_s : NULL;
// As usual, we need to cope with figurative constants:
- cbl_figconst_t figconst = (cbl_figconst_t) ( id1 ? (id1->attr & FIGCONST_MASK) : 0 );
+ figconst = (cbl_figconst_t) ( id1 ? (id1->attr & FIGCONST_MASK) : 0 );
switch( figconst )
{
case low_value_e:
@@ -8861,11 +8923,7 @@ __gg__string(size_t integers[])
whole, whole_end);
if(found)
{
-#pragma GCC diagnostic push
-#pragma GCC diagnostic ignored "-Wcast-qual"
- char *wfound = (char *)found;
-#pragma GCC diagnostic pop
- whole_end = wfound;
+ whole_end = found;
}
}
while(whole < whole_end)
@@ -8915,7 +8973,7 @@ display_both(cblc_field_t *field,
int advance )
{
static size_t display_string_size = MINIMUM_ALLOCATION_SIZE;
- static char *display_string = (char *)malloc(display_string_size);
+ static char *display_string = static_cast<char *>(malloc(display_string_size));
format_for_display_internal(&display_string,
&display_string_size,
@@ -8926,7 +8984,7 @@ display_both(cblc_field_t *field,
// Let's honor the locale of the system, as best we can:
static size_t converted_size = MINIMUM_ALLOCATION_SIZE;
- static char *converted = (char *)malloc(converted_size);
+ static char *converted = static_cast<char *>(malloc(converted_size));
internal_to_console(&converted, &converted_size, display_string, strlen(display_string));
@@ -8936,7 +8994,7 @@ display_both(cblc_field_t *field,
if(ss == -1)
{
fprintf(stderr, "__gg__display() %s %p\n", field->name, qual_data);
- fprintf(stderr, "__gg__display() %zd\n", converted_size);
+ fprintf(stderr, "__gg__display() %ld\n", static_cast<long>(converted_size));
fprintf(stderr, "__gg__display() ");
for(size_t i=0; i<converted_size; i++)
{
@@ -8948,9 +9006,9 @@ display_both(cblc_field_t *field,
if( advance )
{
- ss = write( file_descriptor,
- "\n",
- 1);
+ write( file_descriptor,
+ "\n",
+ 1);
}
}
@@ -8989,20 +9047,20 @@ __gg__display_clean(cblc_field_t *field,
extern "C"
void
-__gg__display_string( int file_descriptor,
- char *str,
- size_t length,
- int advance )
+__gg__display_string( int file_descriptor,
+ const char *str,
+ size_t length,
+ int advance )
{
// Let's honor the locale of the system, as best we can:
static size_t converted_size = MINIMUM_ALLOCATION_SIZE;
- static char *converted = (char *)malloc(converted_size);
+ static char *converted = static_cast<char *>(malloc(converted_size));
size_t max_possible = 2 * length;
if( max_possible > converted_size )
{
converted_size = max_possible;
- converted = (char *)realloc(converted, converted_size);
+ converted = static_cast<char *>(realloc(converted, converted_size));
}
__gg__ascii_to_console(&converted, &converted_size, str, length);
@@ -9138,7 +9196,8 @@ __gg__accept( enum special_name_t special_e,
}
}
- char *buffer = (char *)malloc(max_chars+1);
+ char *buffer = static_cast<char *>(malloc(max_chars+1));
+ massert(buffer);
memset(buffer, ascii_space, max_chars);
buffer[max_chars] = NULLCH;
size_t i = 0;
@@ -9304,7 +9363,7 @@ __gg__binary_value_from_field( int *rdigits,
extern "C"
__int128
__gg__binary_value_from_qualified_field(int *rdigits,
- cblc_field_t *var,
+ const cblc_field_t *var,
size_t offset,
size_t size)
{
@@ -9337,7 +9396,7 @@ __gg__float128_from_field( cblc_field_t *field )
extern "C"
GCOB_FP128
-__gg__float128_from_qualified_field( cblc_field_t *field, size_t offset, size_t size)
+__gg__float128_from_qualified_field(const cblc_field_t *field, size_t offset, size_t size)
{
GCOB_FP128 retval=0;
if( field->type == FldFloat || field->type == FldLiteralN )
@@ -9414,11 +9473,11 @@ __gg__int128_to_qualified_field(cblc_field_t *tgt,
}
static __int128
-float128_to_int128( int *rdigits,
- cblc_field_t *field,
- GCOB_FP128 value,
- cbl_round_t rounded,
- int *compute_error)
+float128_to_int128( int *rdigits,
+ const cblc_field_t *field,
+ GCOB_FP128 value,
+ cbl_round_t rounded,
+ int *compute_error)
{
__int128 retval = 0;
if( value == INFINITY )
@@ -9500,16 +9559,16 @@ float128_to_location( cblc_field_t *tgt,
}
if( value < 0 )
{
- *(float *)(data) = -INFINITY;
+ *PTRCAST(float, data) = -INFINITY;
}
else
{
- *(float *)(data) = INFINITY;
+ *PTRCAST(float, data) = INFINITY;
}
}
else
{
- *(float *)(data) = (float)value;
+ *PTRCAST(float, data) = static_cast<float>(value);
}
break;
@@ -9523,16 +9582,16 @@ float128_to_location( cblc_field_t *tgt,
}
if( value < 0 )
{
- *(double *)(data) = -INFINITY;
+ *PTRCAST(double, data) = -INFINITY;
}
else
{
- *(double *)(data) = INFINITY;
+ *PTRCAST(double, data) = INFINITY;
}
}
else
{
- *(double *)(data) = (double)value;
+ *PTRCAST(double, data) = static_cast<double>(value);
}
break;
@@ -9733,7 +9792,7 @@ __gg__set_initial_switch_value( )
__int128 bit = 1;
char ach[129];
memset(ach, 0, sizeof(ach));
- char *p = getenv("UPSI");
+ const char *p = getenv("UPSI");
if( p )
{
snprintf(ach, sizeof(ach), "%s", p);
@@ -9766,7 +9825,7 @@ is_numeric_display_numeric(cblc_field_t *field, size_t offset, size_t size)
bool leading = !!(field->attr & leading_e);
bool separate = !!(field->attr & separate_e);
- char *digits = (char *)(field->data + offset);
+ char *digits = reinterpret_cast<char *>(field->data + offset);
char *digits_e = digits + size;
if( leading && separate && signable )
@@ -9838,13 +9897,13 @@ is_numeric_display_numeric(cblc_field_t *field, size_t offset, size_t size)
}
static int
-is_packed_numeric(cblc_field_t *field, size_t offset, size_t size)
+is_packed_numeric(const cblc_field_t *field, size_t offset, size_t size)
{
int retval = 1;
bool is_comp6 = !!(field->attr&packed_no_sign_e);
int digits = field->digits;
bool signable = !!(field->attr & signable_e);
- unsigned char *bytes = field->data + offset;
+ const unsigned char *bytes = field->data + offset;
int nybble = 0;
int nybble_e = nybble + digits;
@@ -9913,10 +9972,12 @@ is_packed_numeric(cblc_field_t *field, size_t offset, size_t size)
}
static int
-is_alpha_a_number(cblc_field_t *field, size_t offset, size_t size)
+is_alpha_a_number(const cblc_field_t *field,
+ size_t offset,
+ size_t size)
{
int retval = 1;
- unsigned char *bytes = (field->data + offset);
+ const unsigned char *bytes = (field->data + offset);
for( size_t i=0; i<size; i++ )
{
unsigned char ch = bytes[i];
@@ -9940,7 +10001,7 @@ __gg__classify( classify_t type,
// The default answer is TRUE
int retval = 1;
- const unsigned char *alpha = (unsigned char *)(field->data+offset);
+ const unsigned char *alpha = reinterpret_cast<unsigned char *>(field->data+offset);
size_t str_length = size;
@@ -10071,49 +10132,45 @@ __gg__classify( classify_t type,
return retval;
}
-extern "C"
+static
int
-__gg__accept_envar( cblc_field_t *tgt,
- size_t tgt_offset,
- size_t tgt_length,
- cblc_field_t *name,
- size_t name_offset,
- size_t name_length)
+accept_envar( cblc_field_t *tgt,
+ size_t tgt_offset,
+ size_t tgt_length,
+ const char *psz_name)
{
- int retval;
- tgt_length = tgt_length ? tgt_length : tgt->capacity;
- name_length = name_length ? name_length : name->capacity;
-
- // Pick up the environment variable name, which is in teh internal codeset
- static char *env = NULL;
- static size_t env_length = 0;
- if( env_length < name_length+1 )
+ int retval = 1; // 1 means we couldn't find it
+ if( psz_name )
{
- env_length = name_length+1;
- env = (char *)realloc(env, env_length);
- }
- memcpy(env, name->data + name_offset, name_length);
- env[name_length] = '\0';
+ tgt_length = tgt_length ? tgt_length : tgt->capacity;
- // Get rid of leading and trailing internal_space characters:
- char *trimmed_env = brute_force_trim(env);
+ // Pick up the environment variable name, which is in the internal codeset
+ char *env = strdup(psz_name);
+ massert(env);
- // Convert the name to the console codeset:
- __gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
+ // Get rid of leading and trailing internal_space characters:
+ char *trimmed_env = brute_force_trim(env);
- // Pick up the environment variable, and convert it to the internal codeset
- char *p = getenv(trimmed_env);
- if(p)
- {
- char *pp = strdup(p);
- console_to_internal(pp, strlen(pp));
- retval = 0; // Okay
- move_string(tgt, tgt_offset, tgt_length, pp);
- free(pp);
+ // Convert the name to the console codeset:
+ __gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
+
+ // Pick up the environment variable, and convert it to the internal codeset
+ const char *p = getenv(trimmed_env);
+ if(p)
+ {
+ char *pp = strdup(p);
+ massert(pp);
+ console_to_internal(pp, strlen(pp));
+ retval = 0; // Okay
+ move_string(tgt, tgt_offset, tgt_length, pp);
+ free(pp);
+ }
+ free(env);
}
- else
+
+ if( retval == 1 )
{
- retval = 1; // Could't find it
+ // Could't find it
exception_raise(ec_argument_imp_environment_e);
}
@@ -10121,6 +10178,28 @@ __gg__accept_envar( cblc_field_t *tgt,
}
extern "C"
+int
+__gg__accept_envar( cblc_field_t *tgt,
+ size_t tgt_offset,
+ size_t tgt_length,
+ const cblc_field_t *name,
+ size_t name_offset,
+ size_t name_length)
+ {
+ // We need the name to be nul-terminated:
+ char *p = static_cast<char *>(malloc(name_length + 1));
+ massert(p);
+ memcpy(p, name->data+name_offset, name_length);
+ p[name_length] = '\0';
+ int retval = accept_envar(tgt,
+ tgt_offset,
+ tgt_length,
+ p);
+ free(p);
+ return retval;
+ }
+
+extern "C"
bool
__gg__set_envar(cblc_field_t *name,
size_t name_offset,
@@ -10141,14 +10220,17 @@ __gg__set_envar(cblc_field_t *name,
if( env_length < name_length+1 )
{
env_length = name_length+1;
- env = (char *)realloc(env, env_length);
+ env = static_cast<char *>(realloc(env, env_length));
}
if( val_length < value_length+1 )
{
val_length = value_length+1;
- val = (char *)realloc(val, val_length);
+ val = static_cast<char *>(realloc(val, val_length));
}
+ massert(val);
+ massert(env);
+
// The name and the value arrive in the internal codeset:
memcpy(env, name->data+name_offset , name_length);
env[name_length] = '\0';
@@ -10217,15 +10299,15 @@ command_line_plan_b()
if( bytes_read )
{
char *p = input;
- char *p_end = p + bytes_read;
+ const char *p_end = p + bytes_read;
char prior_char = '\0';
while( p < p_end )
{
if( prior_char == '\0' )
{
stashed_argc += 1;
- stashed_argv = (char **)realloc(stashed_argv,
- stashed_argc * sizeof(char *));
+ stashed_argv = static_cast<char **>(realloc(stashed_argv,
+ stashed_argc * sizeof(char *)));
stashed_argv[stashed_argc-1] = p;
}
prior_char = *p++;
@@ -10296,7 +10378,8 @@ __gg__get_command_line( cblc_field_t *field,
int retcode;
command_line_plan_b();
size_t length = 1;
- char *retval = (char *)malloc(length);
+ char *retval = static_cast<char *>(malloc(length));
+ massert(retval);
*retval = NULLCH;
for( int i=1; i<stashed_argc; i++ )
@@ -10304,7 +10387,8 @@ __gg__get_command_line( cblc_field_t *field,
while( strlen(retval) + strlen(stashed_argv[i]) + 2 > length )
{
length *= 2;
- retval = (char *)realloc(retval, length);
+ retval = static_cast<char *>(realloc(retval, length));
+ massert(retval);
}
if( *retval )
{
@@ -10332,12 +10416,12 @@ __gg__get_command_line( cblc_field_t *field,
extern "C"
void
-__gg__set_pointer(cblc_field_t *target,
- size_t target_o,
- int target_flags,
- cblc_field_t *source,
- size_t source_o,
- int source_flags)
+__gg__set_pointer(cblc_field_t *target,
+ size_t target_o,
+ int target_flags,
+ const cblc_field_t *source,
+ size_t source_o,
+ int source_flags)
{
void *source_address;
if( source_flags & REFER_T_ADDRESS_OF )
@@ -10350,7 +10434,7 @@ __gg__set_pointer(cblc_field_t *target,
// This is SET <something> TO POINTER
if( source )
{
- source_address = *(void **)(source->data + source_o);
+ source_address = *reinterpret_cast<void **>(source->data + source_o);
}
else
{
@@ -10363,7 +10447,7 @@ __gg__set_pointer(cblc_field_t *target,
{
// This is SET ADDRESS OF target TO ....
// We know it has to be an unqualified LINKAGE level 01 or level 77
- target->data = (unsigned char *)source_address;
+ target->data = reinterpret_cast<unsigned char *>(source_address);
// The caller will propogate data + offset to their children.
}
else
@@ -10374,12 +10458,12 @@ __gg__set_pointer(cblc_field_t *target,
// This is [almost certainly] INITIALIZE <pointer> when -fdefaultbyte
// was specified.
memset( target->data+target_o,
- *(unsigned char *)source_address,
+ *reinterpret_cast<unsigned char *>(source_address),
target->capacity);
}
else
{
- *(void **)(target->data+target_o) = source_address;
+ *reinterpret_cast<void **>(target->data+target_o) = source_address;
}
}
}
@@ -10462,7 +10546,7 @@ extern "C"
void
__gg__ascii_to_internal_field(cblc_field_t *var)
{
- ascii_to_internal_str((char *)var->data, var->capacity);
+ ascii_to_internal_str(reinterpret_cast<char *>(var->data), var->capacity);
}
extern "C"
@@ -10514,7 +10598,7 @@ void
__gg__internal_to_console_in_place(char *loc, size_t length)
{
static size_t dest_size = MINIMUM_ALLOCATION_SIZE;
- static char *dest = (char *)malloc(dest_size);
+ static char *dest = static_cast<char *>(malloc(dest_size));
internal_to_console(&dest, &dest_size, loc, length);
memcpy(loc, dest, length);
@@ -10522,8 +10606,8 @@ __gg__internal_to_console_in_place(char *loc, size_t length)
extern "C"
int
-__gg__routine_to_call(char *name,
- int program_id)
+__gg__routine_to_call(const char *name,
+ int program_id)
{
// The list of names is sorted, so at the very least this should be replaced
// with a binary search:
@@ -10539,10 +10623,10 @@ __gg__routine_to_call(char *name,
char **names = *(it->second);
int retval = -1;
- int i=0;
if( names )
{
+ int i=0;
while(*names)
{
if( strstr(*names, name) )
@@ -10564,14 +10648,14 @@ __gg__routine_to_call(char *name,
extern "C"
__int128
-__gg__fetch_call_by_value_value(cblc_field_t *field,
+__gg__fetch_call_by_value_value(const cblc_field_t *field,
size_t field_o,
size_t field_s)
{
int rdigits;
- unsigned char *data = field->data + field_o;
- size_t length = field_s;
+ unsigned char *data = field->data + field_o;
+ const size_t length = field_s;
__int128 retval = 0;
switch(field->type)
@@ -10580,7 +10664,7 @@ __gg__fetch_call_by_value_value(cblc_field_t *field,
case FldAlphanumeric:
case FldAlphaEdited:
case FldLiteralA:
- retval = *(char *)data;
+ retval = *reinterpret_cast<char *>(data);
break;
case FldFloat:
@@ -10588,11 +10672,11 @@ __gg__fetch_call_by_value_value(cblc_field_t *field,
switch(length)
{
case 4:
- *(float *)(&retval) = *(float *)data;
+ *PTRCAST(float, &retval) = *PTRCAST(float, data);
break;
case 8:
- *(double *)(&retval) = *(double *)data;
+ *PTRCAST(double, &retval) = *PTRCAST(double, data);
break;
case 16:
@@ -10649,11 +10733,11 @@ __gg__assign_value_from_stack(cblc_field_t *dest, __int128 parameter)
switch(dest->capacity)
{
case 4:
- *(float *)(dest->data) = *(float *)&parameter;
+ *PTRCAST(float, dest->data) = *PTRCAST(float, (&parameter));
break;
case 8:
- *(double *)(dest->data) = *(double *)&parameter;
+ *PTRCAST(double, dest->data) = *PTRCAST(double, (&parameter));
break;
case 16:
@@ -10687,28 +10771,31 @@ __gg__assign_value_from_stack(cblc_field_t *dest, __int128 parameter)
extern "C"
int
-__gg__literaln_alpha_compare(char *left_side,
- cblc_field_t *right,
- size_t offset,
- size_t length,
- int flags)
+__gg__literaln_alpha_compare(const char *left_side,
+ const cblc_field_t *right,
+ size_t offset,
+ size_t length,
+ int flags)
{
int retval;
if( length == 0 )
{
length = right->capacity;
}
- retval = compare_strings( (char *)left_side,
+ retval = compare_strings( left_side,
strlen(left_side),
false,
- (char *)right->data + offset,
+ reinterpret_cast<char *>((right->data + offset)),
length,
!!(flags & REFER_T_MOVE_ALL) );
return retval;
}
static char *
-string_in(char *str, char *str_e, char *frag, char *frag_e)
+string_in( char *str,
+ const char *str_e,
+ const char *frag,
+ const char *frag_e)
{
// This simple routine could be improved. Instead of using memcmp, we could
// use established, albeit complex, techniques of string searching:
@@ -10738,11 +10825,11 @@ string_in(char *str, char *str_e, char *frag, char *frag_e)
extern "C"
int
-__gg__unstring( cblc_field_t *id1, // The string being unstring
- size_t id1_o,
- size_t id1_s,
+__gg__unstring( const cblc_field_t *id1, // The string being unstring
+ size_t id1_o,
+ size_t id1_s,
size_t ndelimiteds, // The number of DELIMITED entries
- char *all_flags, // The number of ALL flags, one per ndelimiteds
+ const char *all_flags, // The number of ALL flags, one per ndelimiteds
size_t nreceivers, // The number of DELIMITER receivers
cblc_field_t *id7, // The index of characters, both for starting updated at end
size_t id7_o,
@@ -10761,18 +10848,22 @@ __gg__unstring( cblc_field_t *id1, // The string being unstring
// resolved. Each might have an identifier-5 delimiter, and each might have
// an identifier-6 count.
- cblc_field_t **id2 = __gg__treeplet_1f; // The delimiting strings; one per ndelimiteds
- size_t *id2_o = __gg__treeplet_1o;
- size_t *id2_s = __gg__treeplet_1s;
- cblc_field_t **id4 = __gg__treeplet_2f; // The delimited string; one per nreceiver
- size_t *id4_o = __gg__treeplet_2o;
- size_t *id4_s = __gg__treeplet_2s;
- cblc_field_t **id5 = __gg__treeplet_3f; // The delimiting string; one per receiver
- size_t *id5_o = __gg__treeplet_3o;
- size_t *id5_s = __gg__treeplet_3s;
- cblc_field_t **id6 = __gg__treeplet_4f; // The count of characters examined; one per receiver
- size_t *id6_o = __gg__treeplet_4o;
- size_t *id6_s = __gg__treeplet_4s;
+ // The delimiting strings; one per ndelimiteds
+ cblc_field_t **id2 = __gg__treeplet_1f;
+ const size_t *id2_o = __gg__treeplet_1o;
+ const size_t *id2_s = __gg__treeplet_1s;
+ // The delimited string; one per nreceiver
+ cblc_field_t **id4 = __gg__treeplet_2f;
+ const size_t *id4_o = __gg__treeplet_2o;
+ const size_t *id4_s = __gg__treeplet_2s;
+ // The delimiting string; one per receiver
+ cblc_field_t **id5 = __gg__treeplet_3f;
+ const size_t *id5_o = __gg__treeplet_3o;
+ const size_t *id5_s = __gg__treeplet_3s;
+ // The count of characters examined; one per receiver
+ cblc_field_t **id6 = __gg__treeplet_4f;
+ const size_t *id6_o = __gg__treeplet_4o;
+ const size_t *id6_s = __gg__treeplet_4s;
// Initialize the state variables
int overflow = 0;
@@ -10815,8 +10906,8 @@ __gg__unstring( cblc_field_t *id1, // The string being unstring
goto done;
}
- left = (char *)(id1->data+id1_o) + pointer-1;
- right = (char *)(id1->data+id1_o) + id1_s;
+ left = reinterpret_cast<char *>(id1->data+id1_o) + pointer-1;
+ right = reinterpret_cast<char *>(id1->data+id1_o) + id1_s;
if( ndelimiteds == 0 )
{
@@ -10914,8 +11005,9 @@ __gg__unstring( cblc_field_t *id1, // The string being unstring
default:
pfound = string_in( left,
right,
- (char *)(id2[i]->data+id2_o[i]),
- (char *)(id2[i]->data+id2_o[i]) + id2_s[i]);
+ reinterpret_cast<char *>(id2[i]->data+id2_o[i]),
+ reinterpret_cast<char *>((id2[i]->data+id2_o[i])
+ + id2_s[i]));
break;
}
@@ -10992,7 +11084,7 @@ __gg__unstring( cblc_field_t *id1, // The string being unstring
else
{
move_string(id5[nreceiver], id5_o[nreceiver], id5_s[nreceiver],
- (char *)(id2[ifound]->data+id2_o[ifound]),
+ reinterpret_cast<char *>(id2[ifound]->data+id2_o[ifound]),
id2_s[ifound]);
}
}
@@ -11087,15 +11179,15 @@ static inline ec_type_t
local_ec_type_of( file_status_t status )
{
int status10 = (int)status / 10;
- assert( 0 <= status10 ); // was enum, can't be negative.
- if( 10 < status10 )
+ assert( 0 <= status10 ); // was enum, can't be negative.
+ if( 10 < status10 )
{
__gg__abort("local_ec_type_of(): status10 out of range");
}
-
+
static const std::vector<ec_type_t> ec_by_status {
/* 0 */ ec_none_e, // ec_io_warning_e if low byte is nonzero
- /* 1 */ ec_io_at_end_e,
+ /* 1 */ ec_io_at_end_e,
/* 2 */ ec_io_invalid_key_e,
/* 3 */ ec_io_permanent_error_e,
/* 4 */ ec_io_logic_error_e,
@@ -11117,11 +11209,12 @@ local_ec_type_of( file_status_t status )
*/
struct exception_descr_t {
bool location;
- std::set<size_t> files;
+ //std::set<size_t> files;
};
struct cbl_exception_t {
- size_t program, file;
+// size_t program,
+ size_t file;
ec_type_t type;
cbl_file_mode_t mode;
};
@@ -11163,44 +11256,51 @@ match_declarative( bool enabled,
}
if( matches && MATCH_DECLARATIVE ) {
- warnx(" matches exception %s (file %zu mode %s)",
+ warnx(" matches exception %s (file %u mode %s)",
local_ec_type_str(raised.type),
- raised.file,
+ static_cast<unsigned int>(raised.file),
cbl_file_mode_str(raised.mode));
}
}
return matches;
}
-/*
- * The default exception handler is called if:
- * 1. The EC is enabled and was not handled by a Declarative, or
- * 2. The EC is EC-I-O and was not handled by a Format-1 Declarative, or
- * 3. The EC is EC-I-O, associated with a file, and is not OPEN or CLOSE.
- */
-static void
-default_exception_handler( ec_type_t ec )
+static
+void open_syslog(int option, int facility)
{
+ static bool first_time = true;
+ if( first_time ) {
#if HAVE_DECL_PROGRAM_INVOCATION_SHORT_NAME
/* Declared in errno.h, when available. */
- const char *ident = program_invocation_short_name;
+ static const char * const ident = program_invocation_short_name;
#elif defined (HAVE_GETPROGNAME)
/* Declared in stdlib.h. */
- const char *ident = getprogname();
+ static const char * const ident = getprogname();
#else
/* Avoid a NULL entry. */
- const char *ident = "unnamed_COBOL_program";
+ static const char * const ident = "unnamed_COBOL_program";
#endif
- static bool first_time = true;
- static int priority = LOG_INFO, option = LOG_PERROR, facility = LOG_USER;
- ec_disposition_t disposition = ec_category_fatal_e;
-
- if( first_time ) {
// TODO: Program to set option in library via command-line and/or environment.
// Library listens to program, not to the environment.
openlog(ident, option, facility);
first_time = false;
}
+}
+
+/*
+ * The default exception handler is called if:
+ * 1. The EC is enabled and was not handled by a Declarative, or
+ * 2. The EC is EC-I-O and was not handled by a Format-1 Declarative, or
+ * 3. The EC is EC-I-O, associated with a file, and is not OPEN or CLOSE.
+ */
+static void
+default_exception_handler( ec_type_t ec )
+{
+ static const int priority = LOG_INFO, option = LOG_PERROR, facility = LOG_USER;
+ open_syslog(option, facility);
+
+ ec_disposition_t disposition = ec_category_fatal_e;
+
if( ec != ec_none_e ) {
auto pec = std::find_if( __gg__exception_table, __gg__exception_table_end,
@@ -11253,7 +11353,7 @@ default_exception_handler( ec_type_t ec )
case ec_category_fatal_e:
case uc_category_fatal_e:
if( filename ) {
- syslog(priority, "fatal exception: %s:%zu: %s %s: %s (%s)",
+ syslog(priority, "fatal exception: %s:%d: %s %s: %s (%s)",
program_name,
ec_status.lineno,
ec_status.statement,
@@ -11261,7 +11361,7 @@ default_exception_handler( ec_type_t ec )
pec->name,
pec->description);
} else {
- syslog(priority, "fatal exception: %s:%zu: %s: %s (%s)",
+ syslog(priority, "fatal exception: %s:%d: %s: %s (%s)",
program_name,
ec_status.lineno,
ec_status.statement,
@@ -11272,7 +11372,7 @@ default_exception_handler( ec_type_t ec )
break;
case ec_category_nonfatal_e:
case uc_category_nonfatal_e:
- syslog(priority, "%s:%zu: %s: %s (%s)",
+ syslog(priority, "%s:%d: %s: %s (%s)",
program_name,
ec_status.lineno,
ec_status.statement,
@@ -11334,7 +11434,11 @@ __gg__check_fatal_exception()
warnx("%s: ec_status is %s", __func__, ec_status.unset()? "unset" : "set");
if( ec_status.copy_environment().unset() )
+ {
ec_status.update(); // __gg__match_exception was not called first
+ // This is a good time to set the exception code back to zero
+ __gg__exception_code = 0;
+ }
if( ec_status.done() ) { // false for part-handled fatal
if( MATCH_DECLARATIVE )
@@ -11401,8 +11505,10 @@ __gg__exception_push()
{
ec_stack.push(ec_status);
if( MATCH_DECLARATIVE )
- warnx("%s: %s: %zu ECs, %zu declaratives", __func__,
- __gg__exception_statement, enabled_ECs.size(), declaratives.size());
+ warnx("%s: %s: %u ECs, %u declaratives", __func__,
+ __gg__exception_statement,
+ static_cast<unsigned int>(enabled_ECs.size()),
+ static_cast<unsigned int>(declaratives.size()));
}
/*
@@ -11416,8 +11522,10 @@ __gg__exception_pop()
ec_stack.pop();
ec_status.reset_environment();
if( MATCH_DECLARATIVE )
- warnx("%s: %s: %zu ECs, %zu declaratives", __func__,
- __gg__exception_statement, enabled_ECs.size(), declaratives.size());
+ warnx("%s: %s: %u ECs, %u declaratives", __func__,
+ __gg__exception_statement,
+ static_cast<unsigned int>(enabled_ECs.size()),
+ static_cast<unsigned int>(declaratives.size()));
__gg__check_fatal_exception();
}
@@ -11429,24 +11537,13 @@ __gg__clear_exception()
ec_stack.top().clear();
}
-// Update the list of compiler-maintained enabled exceptions.
-extern "C"
-void
-__gg__stash_exceptions( size_t nec, cbl_enabled_exception_t *ecs )
-{
- enabled_ECs = cbl_enabled_exceptions_t(nec, ecs);
-
- if( false && MATCH_DECLARATIVE )
- warnx("%s: %zu exceptions enabled", __func__, nec);
-}
-
void
cbl_enabled_exception_t::dump( int i ) const {
- warnx("cbl_enabled_exception_t: %2d {%s, %s, %zu}",
+ warnx("cbl_enabled_exception_t: %2d {%s, %s, %u}",
i,
location? "location" : " none",
local_ec_type_str(ec),
- file );
+ static_cast<unsigned int>(file) );
}
/*
@@ -11456,7 +11553,7 @@ cbl_enabled_exception_t::dump( int i ) const {
* specific EC. It's matched based on the file's status, irrespective of
* whether or not EC-I-O is enabled. USE Format 1 Declaratives are honored
* regardless of any >>TURN directive.
- *
+ *
* An EC is enabled by the >>TURN directive. The only ECs that can be disabled
* are those that were explicitly enabled. If EC-I-O is enabled, and mentioned
* in a Declarative with USE Format 3, then it is matched just like any other.
@@ -11471,19 +11568,23 @@ __gg__match_exception( cblc_field_t *index )
auto ec = ec_status.update().unhandled();
- if( ec != ec_none_e ) {
+ if( ec != ec_none_e ) {
/*
- * An EC was raised and was not handled by the statement.
- * We know the EC and, for I/O, the current file and its mode.
- * Scan declaratives for a match:
+ * An EC was raised and was not handled by the statement.
+ * We know the EC and, for I/O, the current file and its mode.
+ * Scan declaratives for a match:
* - EC is enabled or program has a Format 1 Declarative
* - EC matches the Declarative's USE statement
- * Format 1 declaratives apply only to EC-I-O, whether or not enabled.
+ * Format 1 declaratives apply only to EC-I-O, whether or not enabled.
* Format 1 may be restricted to a particular mode (for all files).
- * Format 1 and 3 may be restricted to a set of files.
+ * Format 1 and 3 may be restricted to a set of files.
*/
+
+ // This is a good time to set the actual exception code back to zero.
+ __gg__exception_code = 0;
+
auto f = ec_status.file_status();
- cbl_exception_t raised = { 0, f.ifile, ec, f.mode };
+ cbl_exception_t raised = { /*0,*/ f.ifile, ec, f.mode };
bool enabled = enabled_ECs.match(ec);
if( MATCH_DECLARATIVE ) enabled_ECs.dump("match_exception enabled");
@@ -11496,8 +11597,9 @@ __gg__match_exception( cblc_field_t *index )
if( p == declaratives.end() ) {
if( MATCH_DECLARATIVE ) {
warnx("__gg__match_exception:%d: raised exception "
- "%s not matched (%zu enabled)", __LINE__,
- local_ec_type_str(ec), enabled_ECs.size());
+ "%s not matched (%u enabled)", __LINE__,
+ local_ec_type_str(ec),
+ static_cast<unsigned int>(enabled_ECs.size()));
}
} else {
isection = p->section;
@@ -11505,15 +11607,15 @@ __gg__match_exception( cblc_field_t *index )
if( MATCH_DECLARATIVE ) {
warnx("__gg__match_exception:%d: matched "
- "%s against mask %s for section #%zu",
+ "%s against mask %s for section #%u",
__LINE__,
local_ec_type_str(ec),
local_ec_type_str(p->type),
- p->section);
+ static_cast<unsigned int>(p->section));
}
}
- assert(ec != ec_none_e);
- } // end EC match logic
+ assert(ec != ec_none_e);
+ } // end EC match logic
// If a declarative matches the raised exception, return its
// symbol_table index.
@@ -11587,20 +11689,23 @@ __gg__pseudo_return_flush()
extern "C"
GCOB_FP128
-__gg__float128_from_location(cblc_field_t *var, unsigned char *location)
+__gg__float128_from_location( const cblc_field_t *var,
+ const unsigned char *location)
{
GCOB_FP128 retval = 0;
switch( var->capacity )
{
case 4:
{
- retval = *(_Float32 *)location;
+ retval = *reinterpret_cast<_Float32 *>(
+ const_cast<unsigned char *>(location));
break;
}
case 8:
{
- retval = *(_Float64 *)location;
+ retval = *reinterpret_cast<_Float64 *>(
+ const_cast<unsigned char *>(location));
break;
}
@@ -11616,7 +11721,7 @@ __gg__float128_from_location(cblc_field_t *var, unsigned char *location)
extern "C"
__int128
-__gg__integer_from_float128(cblc_field_t *field)
+__gg__integer_from_float128(const cblc_field_t *field)
{
GCOB_FP128 fvalue = __gg__float128_from_location(field, field->data);
// we round() to take care of the possible 2.99999999999... problem.
@@ -11735,7 +11840,7 @@ __gg__func_exception_status(cblc_field_t *dest)
extern "C"
void
-__gg__set_exception_file(cblc_file_t *file)
+__gg__set_exception_file(const cblc_file_t *file)
{
ec_type_t ec = local_ec_type_of( file->io_status );
if( ec )
@@ -11754,7 +11859,8 @@ __gg__set_exception_file(cblc_file_t *file)
extern "C"
void
-__gg__func_exception_file(cblc_field_t *dest, cblc_file_t *file)
+__gg__func_exception_file(cblc_field_t *dest,
+ const cblc_file_t *file)
{
char ach[128];
if( !file )
@@ -11839,7 +11945,7 @@ __gg__set_exception_code(ec_type_t ec, int from_raise_statement)
last_exception_statement = __gg__exception_statement ;
// These are set in __gg__set_exception_file just before this routine is
- // called. In cases where the ec is not a file-i-o operation, we clear
+ // called. In cases where the ec is not a file-i-o operation, we clear
// them here:
if( !(ec & ec_io_e) )
{
@@ -11938,16 +12044,16 @@ __gg__float128_from_int128(cblc_field_t *destination,
extern "C"
int
-__gg__is_float_infinite(cblc_field_t *source, size_t offset)
+__gg__is_float_infinite(const cblc_field_t *source, size_t offset)
{
int retval = 0;
switch(source->capacity)
{
case 4:
- retval = fpclassify( *(_Float32*)(source->data+offset)) == FP_INFINITE;
+ retval = fpclassify( *reinterpret_cast<_Float32*>(source->data+offset)) == FP_INFINITE;
break;
case 8:
- retval = fpclassify( *(_Float64*)(source->data+offset)) == FP_INFINITE;
+ retval = fpclassify( *reinterpret_cast<_Float64*>(source->data+offset)) == FP_INFINITE;
break;
case 16:
// retval = *(_Float128*)(source->data+offset) == INFINITY;
@@ -11961,10 +12067,10 @@ __gg__is_float_infinite(cblc_field_t *source, size_t offset)
extern "C"
int
-__gg__float32_from_128( cblc_field_t *dest,
- size_t dest_offset,
- cblc_field_t *source,
- size_t source_offset)
+__gg__float32_from_128( const cblc_field_t *dest,
+ size_t dest_offset,
+ const cblc_field_t *source,
+ size_t source_offset)
{
int retval = 0;
//_Float128 value = *(_Float128*)(source->data+source_offset);
@@ -11976,37 +12082,37 @@ __gg__float32_from_128( cblc_field_t *dest,
}
else
{
- *(_Float32 *)(dest->data+dest_offset) = (_Float32)value;
+ *reinterpret_cast<_Float32 *>(dest->data+dest_offset) = (_Float32)value;
}
return retval;
}
extern "C"
int
-__gg__float32_from_64( cblc_field_t *dest,
- size_t dest_offset,
- cblc_field_t *source,
- size_t source_offset)
+__gg__float32_from_64( const cblc_field_t *dest,
+ size_t dest_offset,
+ const cblc_field_t *source,
+ size_t source_offset)
{
int retval = 0;
- _Float64 value = *(_Float64*)(source->data+source_offset);
+ _Float64 value = *reinterpret_cast<_Float64*>(source->data+source_offset);
if( FP128_FUNC(fabs)(value) > GCOB_FP128_LITERAL (3.4028235E38) )
{
retval = 1;
}
else
{
- *(_Float32 *)(dest->data+dest_offset) = (_Float32)value;
+ *reinterpret_cast<_Float32 *>(dest->data+dest_offset) = (_Float32)value;
}
return retval;
}
extern "C"
int
-__gg__float64_from_128( cblc_field_t *dest,
- size_t dest_offset,
- cblc_field_t *source,
- size_t source_offset)
+__gg__float64_from_128( const cblc_field_t *dest,
+ size_t dest_offset,
+ const cblc_field_t *source,
+ size_t source_offset)
{
int retval = 0;
// _Float128 value = *(_Float128*)(source->data+source_offset);
@@ -12018,7 +12124,7 @@ __gg__float64_from_128( cblc_field_t *dest,
}
else
{
- *(_Float64 *)(dest->data+dest_offset) = (_Float64)value;
+ *reinterpret_cast<_Float64 *>(dest->data+dest_offset) = (_Float64)value;
}
return retval;
}
@@ -12090,7 +12196,8 @@ __gg__pop_local_variables()
extern "C"
void
-__gg__copy_as_big_endian(unsigned char *dest, unsigned char *source)
+__gg__copy_as_big_endian( unsigned char *dest,
+ const unsigned char *source)
{
// copy eight bytes of source to dest, flipping the endianness
for(size_t i=0; i<8; i++)
@@ -12113,7 +12220,7 @@ __gg__codeset_figurative_constants()
extern "C"
unsigned char *
-__gg__get_figconst_data(cblc_field_t *field)
+__gg__get_figconst_data(const cblc_field_t *field)
{
unsigned char *retval = NULL;
cbl_figconst_t figconst = (cbl_figconst_t)(size_t)(field->initial);
@@ -12198,7 +12305,7 @@ find_in_dirs(const char *dirs, char *unmangled_name, char *mangled_name)
{
while( !retval )
{
- dirent *entry = readdir(dir);
+ const dirent *entry = readdir(dir);
if( !entry )
{
break;
@@ -12254,7 +12361,7 @@ __gg__function_handle_from_cobpath( char *unmangled_name, char *mangled_name)
{
handle_executable = dlopen(NULL, RTLD_LAZY);
}
- if( !retval )
+ //if( !retval )
{
retval = dlsym(handle_executable, unmangled_name);
}
@@ -12278,14 +12385,17 @@ __gg__function_handle_from_cobpath( char *unmangled_name, char *mangled_name)
extern "C"
void
-__gg__just_mangle_name( cblc_field_t *field,
- char **mangled_name
+__gg__just_mangle_name( const cblc_field_t *field,
+ char **mangled_name
)
{
static char ach_name[1024];
static char ach_unmangled[1024];
static char ach_mangled[1024];
+ assert(field);
+ assert(field->data);
+
size_t length;
length = field->capacity;
memcpy(ach_name, field->data, length);
@@ -12299,7 +12409,7 @@ __gg__just_mangle_name( cblc_field_t *field,
bool is_pointer = false;
- if( (field && field->type == FldPointer) )
+ if( field->type == FldPointer )
{
is_pointer = true;
}
@@ -12323,8 +12433,8 @@ __gg__just_mangle_name( cblc_field_t *field,
extern "C"
void *
-__gg__function_handle_from_literal(int program_id,
- char *literal)
+__gg__function_handle_from_literal(int program_id,
+ const char *literal)
{
void *retval = NULL;
static char ach_unmangled[1024];
@@ -12352,7 +12462,7 @@ __gg__function_handle_from_literal(int program_id,
}
PFUNC **pointers_p = it->second;
PFUNC *pointers = *pointers_p;
- retval = (void *)pointers[function_index];
+ retval = reinterpret_cast<void *>(pointers[function_index]);
}
else
{
@@ -12364,10 +12474,10 @@ __gg__function_handle_from_literal(int program_id,
extern "C"
void *
-__gg__function_handle_from_name(int program_id,
- cblc_field_t *field,
- size_t offset,
- size_t length )
+__gg__function_handle_from_name(int program_id,
+ const cblc_field_t *field,
+ size_t offset,
+ size_t length )
{
void *retval = NULL;
static char ach_name[1024];
@@ -12405,7 +12515,7 @@ __gg__function_handle_from_name(int program_id,
}
PFUNC **pointers_p = it->second;
PFUNC *pointers = *pointers_p;
- retval = (void *)pointers[function_index];
+ retval = reinterpret_cast<void *>(pointers[function_index]);
}
else
{
@@ -12441,10 +12551,10 @@ __gg__mirror_range( size_t nrows,
cblc_field_t *src, // The row
size_t src_o,
size_t nspans, // The number of spans
- size_t *spans,
+ const size_t *spans,
size_t table,
size_t ntbl,
- size_t *tbls)
+ const size_t *tbls)
{
static std::unordered_map<size_t, size_t> rows_in_table;
static std::unordered_map<size_t, size_t> widths_of_table;
@@ -12465,7 +12575,7 @@ __gg__mirror_range( size_t nrows,
// We need to know the width of one row of this table, which is different
// depending on type of src:
- cblc_field_t *parent = src;
+ const cblc_field_t *parent = src;
while( parent )
{
if( parent->occurs_upper )
@@ -12587,7 +12697,7 @@ __gg__mirror_range( size_t nrows,
std::vector<size_t> subtable_spans
= spans_in_table [subtable_index];
- unsigned char *subtable_source = source + subtable_offset;
+ const unsigned char *subtable_source = source + subtable_offset;
if( subtable_spans.size() == 0 )
{
@@ -12672,15 +12782,17 @@ __gg__deallocate( cblc_field_t *target,
{
// Target is a pointer. Free the data location
int rdigits;
- void *ptr = (void *)get_binary_value_local(&rdigits,
+ size_t addrv = get_binary_value_local(&rdigits,
target,
target->data + offset,
sizeof(void *));
+ void *ptr = reinterpret_cast<void *>(addrv);
if( ptr )
{
free(ptr);
// And set the data location to zero
- *(char **)(target->data + offset) = NULL;
+ *static_cast<char **>(static_cast<void *>(target->data + offset))
+ = NULL;
}
}
}
@@ -12722,17 +12834,18 @@ get_the_byte(cblc_field_t *field)
extern "C"
void
-__gg__allocate( cblc_field_t *first,
- size_t first_offset,
- int initialized,
- int default_byte,
- cblc_field_t *f_working_byte,
- cblc_field_t *f_local_byte,
- cblc_field_t *returning,
- size_t returning_offset)
+__gg__allocate( cblc_field_t *first,
+ size_t first_offset,
+ int initialized,
+ int default_byte,
+ cblc_field_t *f_working_byte,
+ cblc_field_t *f_local_byte,
+ const cblc_field_t *returning,
+ size_t returning_offset)
{
int working_byte = get_the_byte(f_working_byte);
int local_byte = get_the_byte(f_local_byte);
+ int fill_char;
unsigned char *retval = NULL;
if( first->attr & based_e )
@@ -12740,12 +12853,12 @@ __gg__allocate( cblc_field_t *first,
// first is the BASED variable we are allocating memory for
if( first->capacity )
{
- retval = (unsigned char *)malloc(first->capacity);
+ retval = static_cast<unsigned char *>(malloc(first->capacity));
+ fill_char = 0;
if( initialized )
{
// This is ISO 2023 ALLOCATE rule 7 (ALL TO VALUE)
- int fill_char = 0;
if( default_byte >= 0 )
{
fill_char = default_byte;
@@ -12755,7 +12868,6 @@ __gg__allocate( cblc_field_t *first,
else
{
// This is ISO 2023 ALLOCATE rule 9 (pointers NULL, otherwise OPT_INIT)
- int fill_char = 0;
if( default_byte >= 0 )
{
fill_char = default_byte;
@@ -12799,9 +12911,13 @@ __gg__allocate( cblc_field_t *first,
tsize /= pof10;
if( tsize )
{
- retval = (unsigned char *)malloc(tsize);
+ retval = static_cast<unsigned char *>(malloc(tsize));
+ if(!retval)
+ {
+ abort();
+ }
- int fill_char = 0;
+ fill_char = 0;
if( initialized )
{
// This is ISO 2023 rule 6 (defaultbyte if specified, else zero)
@@ -12840,7 +12956,7 @@ __gg__allocate( cblc_field_t *first,
if( returning )
{
// 'returning' has to be a FldPointer variable; assign the retval to it.
- *(unsigned char **)(returning->data + returning_offset) = retval;
+ *reinterpret_cast<unsigned char **>(returning->data + returning_offset) = retval;
}
}
@@ -12869,7 +12985,8 @@ void
__gg__module_name(cblc_field_t *dest, module_type_t type)
{
static size_t result_size = 64;
- static char *result = (char *)malloc(result_size);
+ static char *result = static_cast<char *>(malloc(result_size));
+ massert(result);
strcpy(result, "");
@@ -12958,7 +13075,7 @@ __gg__module_name(cblc_field_t *dest, module_type_t type)
if( strlen(result) + module_name_stack[i].substr(1).length() + 4 > result_size)
{
result_size *= 2;
- result = (char *)realloc(result, result_size);
+ result = static_cast<char *>(realloc(result, result_size));
}
strcat(result, module_name_stack[i].substr(1).c_str());
strcat(result, ";");
@@ -13019,12 +13136,12 @@ cbl_enabled_exceptions_t::dump( const char tag[] ) const {
}
int i = 1;
for( auto& elem : *this ) {
- warnx("%s: %2d {%s, %04x %s, %ld}", tag,
- i++,
- elem.location? "with location" : " no location",
- elem.ec,
- local_ec_type_str(elem.ec),
- elem.file );
+ warnx("%s: %2d {%s, %04x %s, %u}", tag,
+ i++,
+ elem.location? "with location" : " no location",
+ elem.ec,
+ local_ec_type_str(elem.ec),
+ static_cast<unsigned int>(elem.file) );
}
}
@@ -13057,6 +13174,7 @@ operator<<( std::vector<cbl_declarative_t>& dcls,
}
// The first element of each array is the number of elements that follow
+// The first element of each array is the number of elements that follow
extern "C"
void
__gg__set_exception_environment( uint64_t *ecs, uint64_t *dcls )
@@ -13074,7 +13192,9 @@ __gg__set_exception_environment( uint64_t *ecs, uint64_t *dcls )
if( prior.ecs != ecs ) {
uint64_t *ecs_begin = ecs + 1, *ecs_end = ecs_begin + ecs[0];
if( MATCH_DECLARATIVE ) {
- warnx("%zu elements implies %zu ECs", ecs[0], ecs[0] / 3);
+ warnx("%u elements implies %u ECs",
+ static_cast<unsigned int>(ecs[0]),
+ static_cast<unsigned int>(ecs[0] / 3));
}
cbl_enabled_exceptions_t enabled;
enabled_ECs = enabled.decode( std::vector<uint64_t>(ecs_begin, ecs_end) );
@@ -13088,7 +13208,9 @@ __gg__set_exception_environment( uint64_t *ecs, uint64_t *dcls )
if( prior.dcls != dcls ) {
uint64_t *dcls_begin = dcls + 1, *dcls_end = dcls_begin + dcls[0];
if( MATCH_DECLARATIVE ) {
- warnx("%zu elements implies %zu declaratives", dcls[0], dcls[0] / 21);
+ warnx("%u elements implies %u declaratives",
+ static_cast<unsigned int>(dcls[0]),
+ static_cast<unsigned int>(dcls[0] / 21));
}
declaratives.clear();
declaratives << std::vector<uint64_t>( dcls_begin, dcls_end );
@@ -13103,3 +13225,187 @@ __gg__set_exception_environment( uint64_t *ecs, uint64_t *dcls )
prior.dcls = dcls;
}
+static char *sv_envname = NULL;
+
+extern "C"
+void
+__gg__set_env_name( const cblc_field_t *var,
+ size_t offset,
+ size_t length )
+ {
+ // implements DISPLAY UPON ENVIRONMENT-NAME
+ free(sv_envname);
+ sv_envname = static_cast<char *>(malloc(length+1));
+ massert(sv_envname);
+ memcpy(sv_envname, var->data+offset, length);
+ sv_envname[length] = '\0';
+ }
+
+
+extern "C"
+void
+__gg__get_env_name( cblc_field_t *dest,
+ size_t dest_offset,
+ size_t dest_length)
+ {
+ // Implements ACCEPT FROM ENVIRONMENT-NAME
+ // It returns the value previously established by __gg__set_env_name.
+ if( sv_envname )
+ {
+ sv_envname = strdup("");
+ }
+ move_string(dest, dest_offset, dest_length, sv_envname);
+ }
+
+extern "C"
+int
+__gg__get_env_value(cblc_field_t *dest,
+ size_t dest_offset,
+ size_t dest_length)
+ {
+ return accept_envar(dest,
+ dest_offset,
+ dest_length,
+ sv_envname);
+ }
+
+extern "C"
+void
+__gg__set_env_value(const cblc_field_t *value,
+ size_t offset,
+ size_t length )
+ {
+ // implements DISPLAY UPON ENVIRONMENT-VALUE
+ size_t name_length = strlen(sv_envname);
+ size_t value_length = length;
+
+ static size_t env_length = 16;
+ static char *env = static_cast<char *>(malloc(env_length+1));
+ static size_t val_length = 16;
+ static char *val = static_cast<char *>(malloc(val_length+1));
+ if( env_length < name_length+1 )
+ {
+ env_length = name_length+1;
+ env = static_cast<char *>(realloc(env, env_length));
+ }
+ if( val_length < value_length+1 )
+ {
+ val_length = value_length+1;
+ val = static_cast<char *>(realloc(val, val_length));
+ }
+ massert(env);
+ massert(val);
+
+ // The name and the value arrive in the internal codeset:
+ memcpy(env, sv_envname, name_length);
+ env[name_length] = '\0';
+ memcpy(val, value->data+offset, value_length);
+ val[value_length] = '\0';
+
+ // Get rid of leading and trailing internal_space characters
+ char *trimmed_env = brute_force_trim(env);
+ char *trimmed_val = brute_force_trim(val);
+
+ // Conver them to the console codeset
+ __gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
+ __gg__internal_to_console_in_place(trimmed_val, strlen(trimmed_val));
+
+ // And now, anticlimactically, set the variable:
+ setenv(trimmed_env, trimmed_val, 1);
+ }
+
+extern "C"
+void
+__gg__fprintf_stderr(const char *format_string, ...)
+ __attribute__ ((__format__ (__printf__, 1, 2)));
+
+extern "C"
+void
+__gg__fprintf_stderr(const char *format_string, ...)
+ {
+ /* This routine allows the compiler to send stuff to stderr in a way
+ that is straightforward to use.. */
+ va_list ap;
+ va_start(ap, format_string);
+ vfprintf(stderr, format_string, ap);
+ va_end(ap);
+ }
+
+
+static int sv_argument_number = 0;
+
+extern "C"
+void
+__gg__set_arg_num( const cblc_field_t *index,
+ size_t index_offset,
+ size_t index_size )
+ {
+ // Implements DISPLAY UPON ARGUMENT-NUMBER.
+ int rdigits;
+ __int128 N = get_binary_value_local(&rdigits,
+ index,
+ index->data + index_offset,
+ index_size);
+ // If he gives us fractional digits, just truncate
+ N /= __gg__power_of_ten(rdigits);
+
+ // N is 1-based, per normal COBOL. We have to decrement it here:
+ N -= 1;
+ sv_argument_number = static_cast<int>(N);
+ }
+
+extern "C"
+int
+__gg__accept_arg_value( cblc_field_t *dest,
+ size_t dest_offset,
+ size_t dest_length)
+ {
+ // Implements ACCEPT FROM ARGUMENT-VALUE
+ int retcode;
+ command_line_plan_b();
+ if( sv_argument_number >= stashed_argc || sv_argument_number < 0 )
+ {
+ exception_raise(ec_argument_imp_command_e);
+ retcode = 1; // Error
+ }
+ else
+ {
+ char *retval = strdup(stashed_argv[sv_argument_number]);
+ console_to_internal(retval, strlen(retval));
+ move_string(dest, dest_offset, dest_length, retval);
+ free(retval);
+ retcode = 0; // Okay
+
+ // The Fujitsu spec says bump this value by one.
+ sv_argument_number += 1;
+ }
+ return retcode;
+ }
+
+extern "C"
+int
+__gg__get_file_descriptor(const char *device)
+ {
+ int retval = open(device, O_WRONLY);
+
+ if( retval == -1 )
+ {
+ char *msg;
+ int ec = asprintf(&msg,
+ "Trying to open %s. Got error %s",
+ device,
+ strerror(errno));
+ if( ec != -1 )
+ {
+ static const int priority = LOG_INFO,
+ option = LOG_PERROR,
+ facility = LOG_USER;
+ open_syslog(option, facility);
+ syslog(priority, "%s", msg);
+ }
+
+ // Open a new handle to /dev/stdout, since our caller will be closing it
+ retval = open("/dev/stdout", O_WRONLY);
+ }
+ return retval;
+ }
diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h
index f35987d..2f5c8b0 100644
--- a/libgcobol/libgcobol.h
+++ b/libgcobol/libgcobol.h
@@ -39,6 +39,14 @@
Some are also called between source code modules in libgcobol, hence the
need here for declarations. */
+extern void __gg__mabort();
+
+
+// The unnecessary abort() that follows is necessary to make cppcheck be
+// aware that massert() actually terminates processing after a failed
+// malloc().
+#define massert(p) if(!p){__gg__mabort();abort();}
+
extern "C" __int128 __gg__power_of_ten(int n);
extern "C" __int128 __gg__dirty_to_binary_source( const char *dirty,
@@ -89,22 +97,31 @@ extern "C" char __gg__get_decimal_separator();
extern "C" char __gg__get_decimal_point();
extern "C" char * __gg__get_default_currency_string();
-extern "C" void __gg__clock_gettime(clockid_t clk_id, struct timespec *tp);
+struct cbl_timespec
+ {
+ /* You keep using that word "portability". I do not think it means what
+ you think it means. */
+ time_t tv_sec; // Seconds.
+ long tv_nsec; // Nanoseconds.
+ } ;
+
+extern "C" void __gg__clock_gettime(struct cbl_timespec *tp);
-extern "C" GCOB_FP128 __gg__float128_from_location(cblc_field_t *var,
- unsigned char *location);
+extern "C" GCOB_FP128 __gg__float128_from_location(
+ const cblc_field_t *var,
+ const unsigned char *location);
extern "C" void __gg__adjust_dest_size(cblc_field_t *dest, size_t ncount);
extern "C" void __gg__realloc_if_necessary( char **dest,
size_t *dest_size,
size_t new_size);
-extern "C" void __gg__set_exception_file(cblc_file_t *file);
+extern "C" void __gg__set_exception_file(const cblc_file_t *file);
extern "C" void __gg__internal_to_console_in_place(char *loc, size_t length);
-extern "C" __int128 __gg__binary_value_from_qualified_field(int *rdigits,
- cblc_field_t *var,
+extern "C" __int128 __gg__binary_value_from_qualified_field(int *rdigits,
+ const cblc_field_t *var,
size_t offset,
size_t size);
-extern "C" GCOB_FP128 __gg__float128_from_qualified_field(cblc_field_t *field,
+extern "C" GCOB_FP128 __gg__float128_from_qualified_field(const cblc_field_t *field,
size_t offset,
size_t size);
extern "C" __int128 __gg__integer_from_qualified_field(cblc_field_t *var,
diff --git a/libgcobol/valconv.cc b/libgcobol/valconv.cc
index 873fa93..aaa89f5 100644
--- a/libgcobol/valconv.cc
+++ b/libgcobol/valconv.cc
@@ -29,9 +29,10 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <ctype.h>
-#include <stdio.h>
-#include <string.h>
+#include <cctype>
+#include <cstdio>
+#include <cstring>
+
#include <algorithm>
#include <unordered_map>
#include <vector>
@@ -70,7 +71,7 @@ __gg__realloc_if_necessary(char **dest, size_t *dest_size, size_t new_size)
new_size |= new_size>>16;
new_size |= (new_size>>16)>>16;
*dest_size = new_size + 1;
- *dest = (char *)realloc(*dest, *dest_size);
+ *dest = static_cast<char *>(realloc(*dest, *dest_size));
}
}
@@ -78,7 +79,7 @@ extern "C"
void
__gg__alphabet_create( cbl_encoding_t encoding,
size_t alphabet_index,
- unsigned char *alphabet,
+ const unsigned char *alphabet,
int low_char,
int high_char )
{
@@ -221,7 +222,7 @@ Rindex(const char *dest, int length, char ch)
extern "C"
bool
__gg__string_to_numeric_edited( char * const dest,
- char *source, // In source characters
+ const char *source, // In source characters
int rdigits,
int is_negative,
const char *picture)
@@ -1221,9 +1222,9 @@ got_float:
extern "C"
void
__gg__string_to_alpha_edited( char *dest,
- char *source,
+ const char *source,
int slength,
- char *picture)
+ const char *picture)
{
// Put the PICTURE into the data area. If the caller didn't leave enough
// room, well, poo on them. Said another way; if they specify disaster,
diff --git a/libgcobol/valconv.h b/libgcobol/valconv.h
index d907e6f..1efb2b9 100644
--- a/libgcobol/valconv.h
+++ b/libgcobol/valconv.h
@@ -60,18 +60,18 @@ extern "C"
void __gg__realloc_if_necessary(char **dest, size_t *dest_size, size_t new_size);
void __gg__alphabet_create(cbl_encoding_t encoding,
size_t alphabet_index,
- unsigned char *alphabet,
+ const unsigned char *alphabet,
int low_char,
int high_char );
bool __gg__string_to_numeric_edited(char * const dest,
- char *source, // ASCII
+ const char *source, // ASCII
int rdigits,
int is_negative,
const char *picture);
void __gg__string_to_alpha_edited(char *dest,
- char *source,
+ const char *source,
int slength,
- char *picture);
+ const char *picture);
void __gg__currency_sign_init();
void __gg__currency_sign(int symbol, const char *sign);
void __gg__remove_trailing_zeroes(char *p);