[gcc r17-2901] cobol: Repairs to structure creation. [PR119461]
Robert Dubner via Gcc-cvs <[email protected]> Mon, 3 Aug 2026 17:50:57 +0000 (GMT)
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:71d225bf68f1c5cf31b2e7fd5759b43f8dadc280 commit r17-2901-g71d225bf68f1c5cf31b2e7fd5759b43f8dadc280 Author: Robert Dubner <[email protected]> Date: Mon Aug 3 13:26:27 2026 -0400 cobol: Repairs to structure creation. [PR119461] This PR is over a year old. The original observation that the record layout was done in odd ways has been addressed in the intervening months; these changes finalize those repairs. Some recursive references (where a structure contains a pointer to structures like itself) have been repaired (instead of using a placeholding "char *"). The use of ULONGLONG (a synonym for long_long_unsigned_type_node) has been replaced with UINT64 (for uint64_type_node) in order to reduce possible ambiguity. PR cobol/119461 gcc/cobol/ChangeLog: * genapi.cc (array_of_long_long): Renamed array_of_uint64(). (array_of_uint64): Likewise. (parser_compile_ecs): Use array_of_uint64(). (parser_compile_dcls): Likewise. (parser_file_add): Likewise. (gg_array_of_file_pointers): Use new cblc_file_pp_type_node; * gengen.cc (gg_get_structure_type_decl): Moved to structs.cc and renamed. * gengen.h (ULONGLONG): #define removed and replaced with UINT64. (UINT64): Likewise. (gg_get_structure_type_decl): Declaration removed. * structs.cc (create_structure_type): New function. (get_structure_type_decl): Renamed version of gg_get_structure_type_decl(). (create_cblc_field_t): Cleaned up structure creation. (create_referlet_t): Likewise. (create_refer_t): Likewise. (create_our_type_nodes): Likewise. * structs.h (GTY): New declaration for cblc_file_pp_type_node; * symbols.h (enum cbl_ctype_t): Removed. Diff: --- gcc/cobol/genapi.cc | 36 ++++---- gcc/cobol/gengen.cc | 52 ------------ gcc/cobol/gengen.h | 6 +- gcc/cobol/structs.cc | 228 ++++++++++++++++++++++++++++++++------------------- gcc/cobol/structs.h | 1 + gcc/cobol/symbols.h | 27 ------ 6 files changed, 166 insertions(+), 184 deletions(-) diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 5054a33e4080..a0af39991290 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -885,7 +885,7 @@ parser_initialize_programs( size_t nprogs, } static tree -array_of_long_long(const char *name, +array_of_uint64(const char *name, const std::vector<uint64_t> &vals) { /* @@ -899,14 +899,14 @@ array_of_long_long(const char *name, * ... * }; */ - tree const_ulonglong_type = - build_qualified_type( ULONGLONG, + tree const_uint64_type = + build_qualified_type( UINT64, TYPE_QUAL_CONST ); - tree array_of_ulonglong_type = - build_array_type_nelts( const_ulonglong_type, + tree array_of_uint64_type = + build_array_type_nelts( const_uint64_type, vals.size()+1 ); - tree array_of_ulonglong = - gg_define_variable( array_of_ulonglong_type, + tree array_of_uint64 = + gg_define_variable( array_of_uint64_type, name, vs_file_static ); vec<constructor_elt, va_gc> *elts = NULL; @@ -916,17 +916,17 @@ array_of_long_long(const char *name, CONSTRUCTOR_APPEND_ELT( elts, bitsize_int( 0 ), - build_int_cstu( ULONGLONG, vals.size() ) ); + build_int_cstu( UINT64, vals.size() ) ); for( size_t i=0; i<vals.size(); i++ ) { CONSTRUCTOR_APPEND_ELT( elts, bitsize_int( i+1 ), - build_int_cstu( ULONGLONG, vals[i] ) ); + build_int_cstu( UINT64, vals[i] ) ); } tree constr = - build_constructor( array_of_ulonglong_type, + build_constructor( array_of_uint64_type, elts ); /* * build_constructor() determines TREE_CONSTANT from its elements. @@ -940,9 +940,9 @@ array_of_long_long(const char *name, /* * Record the const qualification on the declaration itself. */ - TREE_READONLY( array_of_ulonglong ) = 1; - DECL_INITIAL( array_of_ulonglong ) = constr; - return array_of_ulonglong; + TREE_READONLY( array_of_uint64 ) = 1; + DECL_INITIAL( array_of_uint64 ) = constr; + return array_of_uint64; } tree @@ -1012,7 +1012,7 @@ parser_compile_ecs( const std::vector<uint64_t>& ecs ) char ach[64]; static int counter = 1; sprintf(ach, "_ecs_table_%d", counter++); - tree retval = array_of_long_long(ach, ecs); + tree retval = array_of_uint64(ach, ecs); SHOW_IF_PARSE(nullptr) { SHOW_PARSE_HEADER @@ -1059,7 +1059,7 @@ parser_compile_dcls( const std::vector<uint64_t>& dcls ) char ach[64]; static int counter = 1; sprintf(ach, "_dcls_table_%d", counter++); - tree retval = array_of_long_long(ach, dcls); + tree retval = array_of_uint64(ach, dcls); SHOW_IF_PARSE(nullptr) { SHOW_PARSE_HEADER @@ -9106,7 +9106,7 @@ parser_file_add(struct cbl_file_t *file) "__gg__file_init", gg_get_address_of(new_var_decl), gg_string_literal(file->name), - build_int_cst_type(ULONGLONG, symbol_table_index), + build_int_cst_type(UINT64, symbol_table_index), array_of_keys, key_numbers, unique_flags, @@ -12196,8 +12196,8 @@ static tree gg_array_of_file_pointers( size_t N, cbl_file_t **files ) { - tree retval = gg_define_variable(build_pointer_type(cblc_file_p_type_node)); - gg_assign(retval, gg_cast( build_pointer_type(cblc_file_p_type_node), + tree retval = gg_define_variable(cblc_file_pp_type_node); + gg_assign(retval, gg_cast( cblc_file_pp_type_node, gg_malloc( build_int_cst_type(SIZE_T, N * int_size_in_bytes(VOID_P))))); for(size_t i=0; i<N; i++) diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc index 601385601b2e..14af64e5ccc6 100644 --- a/gcc/cobol/gengen.cc +++ b/gcc/cobol/gengen.cc @@ -603,58 +603,6 @@ gg_assign(tree dest, const tree source) return stmt; } -tree -gg_get_structure_type_decl(const char *type_name, ...) - { - tree record_type = make_node (RECORD_TYPE); - - tree type_decl = build_decl(UNKNOWN_LOCATION, - TYPE_DECL, - get_identifier (type_name), - record_type); - TYPE_NAME (record_type) = type_decl; - TYPE_STUB_DECL (record_type) = type_decl; - DECL_ARTIFICIAL (type_decl) = 1; - - va_list ap; - va_start (ap, type_name); - - tree first = NULL_TREE; - tree *link = &first; - - for (;;) - { - tree arg_type = va_arg (ap, tree); - if (!arg_type) - { - break; - } - - const char *member_name = va_arg (ap, const char *); - - tree member_decl = build_decl (UNKNOWN_LOCATION, - FIELD_DECL, - get_identifier (member_name), - arg_type); - - DECL_CONTEXT (member_decl) = record_type; - *link = member_decl; - link = &DECL_CHAIN (member_decl); - } - va_end (ap); - - TYPE_FIELDS (record_type) = first; - - layout_type (record_type); -// lang_hooks.decls.pushdecl (type_decl); - - gcc_assert (TREE_CODE (record_type) == RECORD_TYPE); - gcc_assert (TYPE_NAME (record_type)); - gcc_assert (TREE_CODE (TYPE_NAME (record_type)) == TYPE_DECL); - gcc_assert (TREE_TYPE (TYPE_NAME (record_type)) == record_type); - - return record_type; - } void gg_structure_type_constructor(tree record_decl, ...) diff --git a/gcc/cobol/gengen.h b/gcc/cobol/gengen.h index 5c2edb850737..681724d7d3d0 100644 --- a/gcc/cobol/gengen.h +++ b/gcc/cobol/gengen.h @@ -60,7 +60,7 @@ #define LONG long_integer_type_node #define ULONG long_unsigned_type_node #define LONGLONG long_long_integer_type_node -#define ULONGLONG long_long_unsigned_type_node +#define UINT64 uint64_type_node #define SIZE_T size_type_node #define SIZE_T_P (build_pointer_type(SIZE_T)) #define SSIZE_T ptrdiff_type_node @@ -338,9 +338,7 @@ extern tree gg_cast(tree type, tree var); // Assignment, that is to say, A = B extern tree gg_assign(tree dest, const tree source); -// struct creation and field access -// Create struct, and access a field in a struct -extern tree gg_get_structure_type_decl(const char *type_name, ...); +// Create constructor for a record_type extern void gg_structure_type_constructor(tree record_decl, ...); extern tree gg_find_field_in_struct(const tree var_decl, const char *field_name); diff --git a/gcc/cobol/structs.cc b/gcc/cobol/structs.cc index 54e42dd0e383..915b9a9d61be 100644 --- a/gcc/cobol/structs.cc +++ b/gcc/cobol/structs.cc @@ -55,6 +55,8 @@ #include "cobol-system.h" #include "coretypes.h" #include "tree.h" +#include "stringpool.h" +#include "stor-layout.h" #include "../../libgcobol/ec.h" #include "../../libgcobol/common-defs.h" #include "util.h" @@ -156,6 +158,7 @@ tree cblc_field_p_type_node; tree cblc_field_pp_type_node; tree cblc_file_type_node; tree cblc_file_p_type_node; +tree cblc_file_pp_type_node; tree cblc_goto_type_node; tree cblc_referlet_type_node; tree cblc_refer_type_node; @@ -163,6 +166,61 @@ tree cblc_refer_type_node; // The following functions return type_decl nodes for the various structures static tree +create_structure_type(const char *type_name) + { + tree record_type = make_node (RECORD_TYPE); + tree type_decl = build_decl (UNKNOWN_LOCATION, + TYPE_DECL, + get_identifier (type_name), + record_type); + TYPE_NAME (record_type) = type_decl; + TYPE_STUB_DECL (record_type) = type_decl; + DECL_ARTIFICIAL (type_decl) = 1; + return record_type; + } + +static void +get_structure_type_decl(tree record_type, ...) + { + va_list ap; + va_start (ap, record_type); + + tree first = NULL_TREE; + tree *link = &first; + + for (;;) + { + tree arg_type = va_arg (ap, tree); + if (!arg_type) + { + break; + } + + const char *member_name = va_arg (ap, const char *); + + tree member_decl = build_decl (UNKNOWN_LOCATION, + FIELD_DECL, + get_identifier (member_name), + arg_type); + + DECL_CONTEXT (member_decl) = record_type; + DECL_CHAIN (member_decl) = NULL_TREE; + *link = member_decl; + link = &DECL_CHAIN (member_decl); + } + va_end (ap); + + TYPE_FIELDS (record_type) = first; + + layout_type (record_type); + + gcc_assert (TREE_CODE (record_type) == RECORD_TYPE); + gcc_assert (TYPE_NAME (record_type)); + gcc_assert (TREE_CODE (TYPE_NAME (record_type)) == TYPE_DECL); + gcc_assert (TREE_TYPE (TYPE_NAME (record_type)) == record_type); + } + +static void create_cblc_field_t() { /* @@ -187,29 +245,32 @@ create_cblc_field_t() int alphabet; // Same as cbl_field_t::codeset::language } cblc_field_t; */ - tree retval = gg_get_structure_type_decl("cblc_field_t", - UCHAR_P, "data", - SIZE_T, "capacity", - SIZE_T, "allocated", - SIZE_T, "offset", - CHAR_P, "name", - CHAR_P, "picture", - CHAR_P, "initial", - CHAR_P, "parent", - SIZE_T, "occurs_lower", - SIZE_T, "occurs_upper", - ULONGLONG, "attr", - SCHAR, "type", - SCHAR, "level", - SCHAR, "digits", - SCHAR, "rdigits", - INT, "encoding", - INT, "alphabet", - NULL_TREE); - return retval; + cblc_field_type_node = create_structure_type ("cblc_field_t"); + cblc_field_p_type_node = build_pointer_type(cblc_field_type_node); + cblc_field_pp_type_node = build_pointer_type(cblc_field_p_type_node); + + get_structure_type_decl( cblc_field_type_node, + UCHAR_P, "data", + SIZE_T, "capacity", + SIZE_T, "allocated", + SIZE_T, "offset", + CHAR_P, "name", + CHAR_P, "picture", + CHAR_P, "initial", + cblc_field_p_type_node, "parent", + SIZE_T, "occurs_lower", + SIZE_T, "occurs_upper", + UINT64, "attr", + SCHAR, "type", + SCHAR, "level", + SCHAR, "digits", + SCHAR, "rdigits", + INT, "encoding", + INT, "alphabet", + NULL_TREE); } -static tree +static void create_cblc_file_t() { // When doing FILE I/O, you need the cblc_file_t structure @@ -257,49 +318,52 @@ typedef struct cblc_file_t int alphabet; // Actually cbl_encoding_t } cblc_file_t; */ - tree retval = gg_get_structure_type_decl("cblc_file_t", - CHAR_P, "name", - ULONGLONG, "symbol_table_index", - CHAR_P, "filename", - FILE_P, "file_pointer", - SIZE_T, "file_fpos", - CHAR_P, "buffer", - SIZE_T, "buffer_pos", - SIZE_T, "buffer_len", - cblc_field_p_type_node, "default_record", - SIZE_T, "record_area_min", - SIZE_T, "record_area_max", - build_pointer_type(cblc_field_p_type_node), "keys", - build_pointer_type(INT),"key_numbers", - build_pointer_type(INT),"uniques", - cblc_field_p_type_node, "password", - cblc_field_p_type_node, "status", - cblc_field_p_type_node, "user_status", - cblc_field_p_type_node, "vsam_status", - cblc_field_p_type_node, "record_length", - VOID_P, "supplemental", - VOID_P, "implementation", - SIZE_T, "reserve", - LONG, "prior_read_location", - INT, "org", - INT, "access", - INT, "mode_char", - INT, "errnum", - INT, "io_status", - INT, "padding", - UINT, "delimiter", - INT, "stride", - INT, "flags", - UINT, "recent_char", - INT, "recent_key", - INT, "prior_op", - INT, "encoding", // Actually cbl_encoding_t - INT, "alphabet", - NULL_TREE); - return retval; + cblc_file_type_node = create_structure_type ("cblc_file_t"); + cblc_file_p_type_node = build_pointer_type(cblc_file_type_node); + cblc_file_pp_type_node = build_pointer_type(cblc_file_p_type_node); + + get_structure_type_decl(cblc_file_type_node, + CHAR_P, "name", + UINT64, "symbol_table_index", + CHAR_P, "filename", + FILE_P, "file_pointer", + SIZE_T, "file_fpos", + CHAR_P, "buffer", + SIZE_T, "buffer_pos", + SIZE_T, "buffer_len", + cblc_field_p_type_node, "default_record", + SIZE_T, "record_area_min", + SIZE_T, "record_area_max", + cblc_field_pp_type_node, "keys", + build_pointer_type(INT),"key_numbers", + build_pointer_type(INT),"uniques", + cblc_field_p_type_node, "password", + cblc_field_p_type_node, "status", + cblc_field_p_type_node, "user_status", + cblc_field_p_type_node, "vsam_status", + cblc_field_p_type_node, "record_length", + VOID_P, "supplemental", + VOID_P, "implementation", + SIZE_T, "reserve", + LONG, "prior_read_location", + INT, "org", + INT, "access", + INT, "mode_char", + INT, "errnum", + INT, "io_status", + INT, "padding", + UINT, "delimiter", + INT, "stride", + INT, "flags", + UINT, "recent_char", + INT, "recent_key", + INT, "prior_op", + INT, "encoding", // Actually cbl_encoding_t + INT, "alphabet", + NULL_TREE); } -static tree +static void create_referlet_t() { /* @@ -310,15 +374,16 @@ create_referlet_t() size_t size; } cblc_referlet_t; */ - tree retval = gg_get_structure_type_decl("cblc_referlet_t", - cblc_field_p_type_node, "field", - SIZE_T, "offset", - SIZE_T, "size", - NULL_TREE); - return retval; + cblc_referlet_type_node = create_structure_type ("cblc_referlet_type_node"); + + get_structure_type_decl(cblc_referlet_type_node, + cblc_field_p_type_node, "field", + SIZE_T, "offset", + SIZE_T, "size", + NULL_TREE); } -static tree +static void create_refer_t() { /* @@ -330,13 +395,13 @@ create_refer_t() int flags; } cblc_refer_t; */ - tree retval = gg_get_structure_type_decl("cblc_refer_t", - cblc_field_p_type_node, "field", - SIZE_T, "offset", - SIZE_T, "size", - INT, "flags", - NULL_TREE); - return retval; + cblc_refer_type_node = create_structure_type ("cblc_refer_t"); + get_structure_type_decl(cblc_refer_type_node, + cblc_field_p_type_node, "field", + SIZE_T, "offset", + SIZE_T, "size", + INT, "flags", + NULL_TREE); } void @@ -346,13 +411,10 @@ create_our_type_nodes() if( just_once ) { just_once = false; - cblc_field_type_node = create_cblc_field_t(); - cblc_field_p_type_node = build_pointer_type(cblc_field_type_node); - cblc_field_pp_type_node = build_pointer_type(cblc_field_p_type_node); - cblc_file_type_node = create_cblc_file_t(); - cblc_file_p_type_node = build_pointer_type(cblc_file_type_node); - cblc_referlet_type_node = create_referlet_t(); - cblc_refer_type_node = create_refer_t(); + create_cblc_field_t(); + create_cblc_file_t(); + create_referlet_t(); + create_refer_t(); } } diff --git a/gcc/cobol/structs.h b/gcc/cobol/structs.h index a9c7f879b462..5f17452de6a3 100644 --- a/gcc/cobol/structs.h +++ b/gcc/cobol/structs.h @@ -54,6 +54,7 @@ extern GTY(()) tree cblc_field_p_type_node; extern GTY(()) tree cblc_field_pp_type_node; extern GTY(()) tree cblc_file_type_node; extern GTY(()) tree cblc_file_p_type_node; +extern GTY(()) tree cblc_file_pp_type_node; extern GTY(()) tree cblc_goto_type_node; extern GTY(()) tree cblc_referlet_type_node; extern GTY(()) tree cblc_refer_type_node; diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 374554877889..ddbe3176df75 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -1704,33 +1704,6 @@ enum cbl_intrinsic_trim_t { trim_trailing_e = 2, }; -enum cbl_ctype_t { - c_unknown, - c_bool, - c_char, - c_wchar, - c_byte, - c_ubyte, - c_short, - c_ushort, - c_int, - c_uint, - c_long, - c_ulong, - c_longlong, - c_ulonglong, - c_size_t, - c_ssize_t, - c_int128, - c_float, - c_double, - c_longdouble, - c_char_p, - c_wchar_p, - c_void_p, - c_nts, // this is a null-terminated-string char_p -}; - struct function_descr_arg_t { size_t isym; cbl_ffi_crv_t crv;