mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-21 19:35:36 -05:00
We expanded our extended testing regime to execute many testcases in EBCDIC mode as well as in ASCII. This exposed hundreds of problems in both compilation (where conversions must be made between the ASCII source code and the EBCDIC execution environment) and in run-time functionality, where results from calls to system routines and internal calculations that must be done in ASCII have to be converted to EBCDIC. These changes also switch to using FIXED_WIDE_INT(128) instead of REAL_VALUE_TYPE when initializing fixed-point COBOL variable types. This provides for accurate initialization up to 37 digits, instead of losing accuracy after 33 digits. These changes also support the implementation of the COBOL DELETE FILE (Format 2) statement. These changes also introduce expanded support for specifying character encodings, including support for locales. co-authored-by: Robert Dubner <rdubner@symas.com> co-authored-by: James K. Lowden <jklowden@cobolworx.com> gcc/cobol/ChangeLog: * Make-lang.in: Repair documentation generation. * cdf.y: Changes to tokens. * cobol1.cc (cobol_langhook_handle_option): Add comment. * genapi.cc (function_pointer_from_name): Use data.original() for function name. (parser_initialize_programs): Likewise. (cobol_compare): Make sure encodings of comparands are the same. (move_tree): Change name of DEFAULT_SOURCE_ENCODING macro. (parser_enter_program): Typo. (psa_FldLiteralN): Break out dirty_to_binary() support routine. (dirty_to_binary): Likewise. (parser_alphabet): Rename 'alphabet' to 'collation_sequence'. (parser_allocate): Change wsclear() to be uint32_t instead of char. (parser_label_label): Formatting. (parser_label_goto): Likewise. (get_the_filename): Breakout get_the_filename(), which handles encoding. (parser_file_open): Likewise. (set_up_delete_file_label): Implement DELETE FILE (Format 2). (parser_file_delete_file): Likewise. (parser_file_delete_on_exception): Likewise. (parser_file_delete_not_exception): Likewise. (parser_file_delete_end): Likewise. (parser_call): Use data.original(). (parser_entry): Use data.original(). (mh_source_is_literalN): Convert from sourceref.field->codeset.encoding. (binary_initial_from_float128): Change to "binary_initial". (binary_initial): Calculate in FIXED_WIDE_INT(128) instead of REAL_VALUE_TYPE. (digits_from_int128): New routine uses binary_initial. (digits_from_float128): Removed. Kept as comment for reference. (initial_from_initial): Use binary_initial. (actually_create_the_static_field): Use correct encoding. (parser_symbol_add): Likewise. * genapi.h (parser_file_delete_file): Implement FILE DELETE. (parser_file_delete_on_exception): Implement FILE DELETE. (parser_file_delete_not_exception): Implement FILE DELETE. (parser_file_delete_end): Implement FILE DELETE. * genmath.cc: Include charmaps.h. * genutil.cc (get_literal_string): Change name of DEFAULT_SOURCE_ENCODING macro. * parse.y: Token changes; numerous changes in support of encoding; support for DELETE FILE. * parse_ante.h (name_of): Use data.original(). (class prog_descr_t): Support of locales. (current_options): Formatting. (current_encoding): Formatting. (current_program_index): Formatting. (current_section): Formatting. (current_paragraph): Formatting. (is_integer_literal): Use correct encoding. (value_encoding_check): Handle encoding changes. (alphabet_add): Likewise. (data_division_ready): Likewise. * scan.l: Use data.original(). * show_parse.h: Use correct encoding. * symbols.cc (elementize): Likewise. (symbol_elem_cmp): Handle locale. (struct symbol_elem_t): Likewise. (symbol_locale): Likewise. (field_str): Change DEFAULT_SOURCE_ENCODING macro name. (symbols_alphabet_set): Formatting. (symbols_update): Modify consistency checks. (symbol_locale_add): Locale support. (cbl_locale_t::cbl_locale_t): Locale support. (cbl_alphabet_t::cbl_alphabet_t): New structure. (cbl_alphabet_t::reencode): Formatting. (cbl_alphabet_t::assign): Change name of collation_sequence. (cbl_alphabet_t::also): Likewise. (new_literal_add): Anticipate the need for four-byte characters. (guess_encoding): Eliminate. (cbl_field_t::internalize): Refine conversion of data.initial to specified encoding. * symbols.h (enum symbol_type_t): Add SymLocale. (struct cbl_field_data_t): Incorporate data.orig. (struct cbl_field_t): Likewise. (struct cbl_delete_file_t): New structure. (struct cbl_label_t): Incorporate cbl_delete_file_t. (struct cbl_locale_t): Support for locale. (hex_decode): Comment. (struct cbl_alphabet_t): Incorporate locale; change variable name to collation_sequence. (struct symbol_elem_t): Incorporate locale. (cbl_locale_of): Likewise. (cbl_alphabet_of): Likewise. (symbol_locale_add): Likewise. (wsclear): Type is now uint32_t instead of char. * util.cc (symbol_type_str): Incorporate locale. (cbl_field_t::report_invalid_initial_value): Change test so that pure PIC A() variables are limited to [a-zA-Z] and space. (valid_move): Use DEFAULT_SOURCE_ENCODING macro. (cobol_filename): Formatting. libgcobol/ChangeLog: * charmaps.cc (__gg__encoding_iconv_type): Eliminate trailing '/' characters from encoding names. (__gg__get_charmap): Switch to DEFAULT_SOURCE_ENCODING macro name. * charmaps.h (DEFAULT_CHARMAP_SOURCE): Likewise. (DEFAULT_SOURCE_ENCODING): Likewise. (class charmap_t): Enhance constructor. * encodings.h (valid_encoding): New routine. * gcobolio.h (enum cblc_file_prior_op_t): Support DELETE FILE. * gfileio.cc (get_filename): Likewise. (__io__file_remove): Likewise. (__gg__file_reopen): Likewise. (__io__file_open): Likewise. (gcobol_fileops): Likewise. (__gg__file_delete): Likewise. (__gg__file_remove): Likewise. * intrinsic.cc (get_all_time): Switch to DEFAULT_SOURCE_ENCODING macro name. (ftime_replace): Support ASCII/EBCDIC encoding. (__gg__current_date): Likewise. (__gg__max): Likewise. (__gg__lower_case): Likewise. (numval): Likewise. (numval_c): Likewise. (__gg__upper_case): Likewise. (__gg__when_compiled): Likewise. (gets_int): Likewise. (gets_nanoseconds): Likewise. (fill_cobol_tm): Likewise. (floating_format_tester): Likewise. (__gg__numval_f): Likewise. (__gg__test_numval_f): Likewise. (iscasematch): Likewise. (strcasestr): Likewise. (strcaselaststr): Likewise. (__gg__substitute): Likewise. (__gg__locale_compare): Support for locale. (__gg__locale_date): Likewise. (__gg__locale_time): Likewise. (__gg__locale_time_from_seconds): Likewise. * libgcobol.cc (class ec_status_t): Support for encoding. (int128_to_field): Likewise. (__gg__dirty_to_float): Likewise. (format_for_display_internal): Likewise. (get_float128): Likewise. (compare_field_class): Likewise. (__gg__compare_2): Likewise. (init_var_both): Likewise. (__gg__move): Likewise. (display_both): Likewise. (is_numeric_display_numeric): Likewise. (accept_envar): Likewise. (__gg__get_argv): Likewise. (__gg__unstring): Likewise. (__gg__check_fatal_exception): Likewise. (__gg__adjust_encoding): Likewise. (__gg__func_exception_location): Likewise. (__gg__func_exception_statement): Likewise. (__gg__func_exception_status): Likewise. (__gg__func_exception_file): Likewise. (__gg__just_mangle_name): Likewise. (__gg__function_handle_from_name): Likewise. (get_the_byte): Likewise. (__gg__module_name): Likewise. (__gg__accept_arg_value): Likewise. * xmlparse.cc (fatalError): Formatting. (setDocumentLocator): Formatting. (xmlchar_of): Formatting. (xmlParserErrors_str): Formatting.
159 lines
7.2 KiB
C++
159 lines
7.2 KiB
C++
/*
|
|
* Copyright (c) 2021-2025 Symas Corporation
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions are
|
|
* met:
|
|
*
|
|
* * Redistributions of source code must retain the above copyright
|
|
* notice, this list of conditions and the following disclaimer.
|
|
* * Redistributions in binary form must reproduce the above
|
|
* copyright notice, this list of conditions and the following disclaimer
|
|
* in the documentation and/or other materials provided with the
|
|
* distribution.
|
|
* * Neither the name of the Symas Corporation nor the names of its
|
|
* contributors may be used to endorse or promote products derived from
|
|
* this software without specific prior written permission.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
*/
|
|
#ifndef GCOBOLIO_H_
|
|
#define GCOBOLIO_H_
|
|
|
|
#include <cstdio>
|
|
|
|
#include <map>
|
|
#include <unordered_map>
|
|
#include <vector>
|
|
|
|
// RUNTIME structures *must* match the ones created in structs.c and initialized
|
|
// and used in genapi.c. It's actually not all that important to emphasize that
|
|
// fact, since the compiled executable will crash and burn quickly if they don't
|
|
// match precisely.
|
|
|
|
// Note that it must match the same structure in the GDB-COBOL debugger
|
|
|
|
typedef struct cblc_field_t
|
|
{
|
|
// This structure must match the code in structs.cc
|
|
unsigned char *data; // The runtime data. There is no null terminator
|
|
size_t capacity; // The size of "data"
|
|
size_t allocated; // The number of bytes available for capacity
|
|
size_t offset; // Offset from our ancestor (see note below)
|
|
char *name; // The null-terminated name of this variable
|
|
char *picture; // The null-terminated picture string.
|
|
char *initial; // The null_terminated initial value
|
|
struct cblc_field_t *parent;// This field's immediate parent field
|
|
size_t occurs_lower; // non-zero for a table
|
|
size_t occurs_upper; // non-zero for a table
|
|
unsigned long long attr; // See cbl_field_attr_t
|
|
signed char type; // A one-byte copy of cbl_field_type_t
|
|
signed char level; // This variable's level in the naming heirarchy
|
|
signed char digits; // Digits specified in PIC string; e.g. 5 for 99v999
|
|
signed char rdigits; // Digits to the right of the decimal point. 3 for 99v999
|
|
cbl_encoding_t encoding; //
|
|
int alphabet; // Same as cbl_field_t::codeset::language
|
|
} cblc_field_t;
|
|
|
|
/*
|
|
* Implementation details
|
|
*/
|
|
|
|
class supplemental_t;
|
|
|
|
enum cblc_file_prior_op_t
|
|
{
|
|
file_op_none,
|
|
file_op_open,
|
|
file_op_start,
|
|
file_op_read,
|
|
file_op_write,
|
|
file_op_rewrite,
|
|
file_op_delete,
|
|
file_op_close,
|
|
file_op_remove,
|
|
};
|
|
|
|
/* end implementation details */
|
|
|
|
enum cblc_file_flags_t
|
|
{
|
|
file_flag_none_e = 0x00000,
|
|
file_flag_optional_e = 0x00001,
|
|
file_flag_existed_e = 0x00002,
|
|
file_name_quoted_e = 0x00004,
|
|
file_flag_initialized_e = 0x00008,
|
|
};
|
|
|
|
typedef struct cblc_file_t
|
|
{
|
|
// This structure must match the code in structs.cc
|
|
char *name; // This is the name of the structure; might be the name of an environment variable
|
|
size_t symbol_table_index; // of the related cbl_field_t structure
|
|
char *filename; // The name of the file to be opened
|
|
FILE *file_pointer; // The FILE *pointer
|
|
cblc_field_t *default_record; // The record_area
|
|
size_t record_area_min; // The size of the smallest 01 record in the FD
|
|
size_t record_area_max; // The size of the largest 01 record in the FD
|
|
cblc_field_t **keys; // For relative and indexed files. The first is the primary key. Null-terminated.
|
|
int *key_numbers; // One per key -- each key has a number. This table is key_number + 1
|
|
int *uniques; // One per key
|
|
cblc_field_t *password; //
|
|
cblc_field_t *status; // This must exist, and is the cbl_field_t version of io_status
|
|
cblc_field_t *user_status; // This might exist, and is another copy See 2014 standard, section 9.1.12
|
|
cblc_field_t *vsam_status; //
|
|
cblc_field_t *record_length; //
|
|
supplemental_t *supplemental; //
|
|
void *implementation; // reserved for any implementation
|
|
size_t reserve; // From I-O section RESERVE clause
|
|
long prior_read_location; // Location of immediately preceding successful read
|
|
cbl_file_org_t org; // from ORGANIZATION clause
|
|
cbl_file_access_t access; // from ACCESS MODE clause
|
|
int mode_char; // 'r', 'w', '+', or 'a' from FILE OPEN statement
|
|
int errnum; // most recent errno; can't reuse "errno" as the name
|
|
file_status_t io_status; // See 2014 standard, section 9.1.12
|
|
int padding; // Actually a char
|
|
int delimiter; // ends a record; defaults to '\n'.
|
|
int flags; // cblc_file_flags_t
|
|
int recent_char; // This is the most recent char sent to the file
|
|
int recent_key;
|
|
cblc_file_prior_op_t prior_op; // run-time type is INT
|
|
cbl_encoding_t encoding; // We assume size int
|
|
int alphabet; // Actually cbl_encoding_t
|
|
int dummy;
|
|
} cblc_file_t;
|
|
|
|
|
|
/* In various arithmetic routines implemented in libgcobol, it is oftent the
|
|
case that complicates lists of variables need to be conveyed. For example,
|
|
"ADD A B C D GIVING E" and "ADD A TO B C D" are valid instructions.
|
|
|
|
These treeplets (triplets of trees) were created to handle that. */
|
|
|
|
extern cblc_field_t ** __gg__treeplet_1f;
|
|
extern size_t * __gg__treeplet_1o;
|
|
extern size_t * __gg__treeplet_1s;
|
|
extern cblc_field_t ** __gg__treeplet_2f;
|
|
extern size_t * __gg__treeplet_2o;
|
|
extern size_t * __gg__treeplet_2s;
|
|
extern cblc_field_t ** __gg__treeplet_3f;
|
|
extern size_t * __gg__treeplet_3o;
|
|
extern size_t * __gg__treeplet_3s;
|
|
extern cblc_field_t ** __gg__treeplet_4f;
|
|
extern size_t * __gg__treeplet_4o;
|
|
extern size_t * __gg__treeplet_4s;
|
|
|
|
extern int * __gg__fourplet_flags;
|
|
|
|
#endif
|