From: Robert Dubner <[email protected]>
Date: Mon, 3 Aug 2026 13:26:27 -0400
Subject: [PATCH] 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.
---
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 5054a33e408..a0af3999129 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 601385601b2..14af64e5ccc 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 5c2edb85073..681724d7d3d 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 54e42dd0e38..915b9a9d61b 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 a9c7f879b46..5f17452de6a 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 37455487788..ddbe3176df7 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;
--
2.34.1
