From 71d225bf68f1c5cf31b2e7fd5759b43f8dadc280 Mon Sep 17 00:00:00 2001
From: Robert Dubner <rdubner@symas.com>
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.47.3