diff --git a/gcc/cobol/ChangeLog b/gcc/cobol/ChangeLog
index a9f47eb1113299bdb45f363110a1e98f17c58240..48e3995487b7bf53d5ed3364fc423807cbe51cc2 100644
--- a/gcc/cobol/ChangeLog
+++ b/gcc/cobol/ChangeLog
@@ -1,12 +1,6 @@
-2025-02-07 Robert Dubner <rdubner@symas.com>
- * Modified configure.ac and Makefile.in to notices that MULTISUBDIR=/32 to
- suppress 32-builds.
- * Eliminate -Wunused-result warning in libgcobol.cc compilation
-
-2025-02-11 Robert Dubner <rdubner@symas.com>
- * libgcobol quietly is not built for -m32 systems in a multi-lib build
- * configure.ac allows COBOL only for x86_64 and aarch64 architectures.
- Other systems get a warning and the COBOL language is suppressed.
+2025-02-16
+ * Added GTY(()) tags to gengen.h and structs.h. Put includes for them into
+ cobol1.cc
2025-01-28 Robert Dubner <rdubner@symas.com>
* Remove TRACE1 statements from parser_enter_file and parser_leave_file;
diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index e5e1b9720c203fc600b88161b4b718c4ff8754e3..819e3e45f25629629aec5722be4992d1feb2c9f3 100644
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -66,8 +66,8 @@ along with GCC; see the file COPYING3. If not see
#include "exceptl.h"
#include "exceptg.h"
#include "util.h"
-#include "gengen.h"
-
+#include "gengen.h" // This has some GTY(()) markers
+#include "structs.h" // This has some GTY(()) markers
/* Required language-dependent contents of a type. */
@@ -639,11 +639,6 @@ cobol_name_mangler(const char *cobol_name_)
}
free(cobol_name);
- if( getenv("SHOW_MANGLED") )
- {
- fprintf(stderr, "mangled %32s to %-32s in %s\n", cobol_name_, psz, __func__);
- }
-
for(size_t i=0; i<strlen(psz); i++)
{
if( psz[i] & 0x80 )
@@ -743,11 +738,6 @@ cobol_name_mangler_callback(const char *cobol_name_)
}
free(cobol_name);
- if( getenv("SHOW_MANGLED") )
- {
- fprintf(stderr, "mangled %32s to %-32s in %s\n", cobol_name_, psz, __func__);
- }
-
for(size_t i=0; i<strlen(psz); i++)
{
if( psz[i] & 0x80 )
@@ -795,11 +785,6 @@ cobol_set_decl_assembler_name (tree decl)
strcpy(mangled_name, name);
}
- if(getenv("SHOW_MANGLE"))
- {
- fprintf(stderr, "%s(): %30s becomes %30s\n", __func__, name, mangled_name);
- }
-
bool is_cobol_name(const char name[]);
if( false ) {
@@ -809,12 +794,6 @@ cobol_set_decl_assembler_name (tree decl)
dbgmsg("Public/FileScope %s", name);
}
}
-
- if(getenv("SEE_NAMES") && strncmp( name, "__", 2) )
- {
- fprintf(stderr, "set %30.30s", name);
- fprintf(stderr, " to %30.30s\n", mangled_name);
- }
}
id = get_identifier(mangled_name);
diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc
index f044d45e530593130918c9e329c14548444eb439..845d58b0cda7d2dc5c248f1d61093b432940a163 100644
--- a/gcc/cobol/gengen.cc
+++ b/gcc/cobol/gengen.cc
@@ -434,12 +434,6 @@ gg_assign(tree dest, const tree source)
tree source_type = adjust_for_type(TREE_TYPE(source));
bool p2 = saw_pointer;
- if( getenv("X2") )
- {
- fprintf(stderr, "dest is %s%s;", show_type(dest_type), p1 ? "_P" : "");
- fprintf(stderr, " source is %s%s\n", show_type(source_type), p2 ? "_P" : "");
- }
-
bool okay = dest_type == source_type;
if( !okay )
@@ -464,31 +458,23 @@ gg_assign(tree dest, const tree source)
}
else
{
- if( true || getenv("X1") )
+ // We are doing an assignment where the left- and right-hand types are not
+ // the same. This is a compilation-time error, since we want the caller to
+ // have sorted the types out explicitly. If we don't throw an error here,
+ // the gimple reduction will do so. Better to do it here, when we know
+ // where we are.
+ dbgerr("Inefficient assignment");
+ if(DECL_P(dest) && DECL_NAME(dest))
{
- dbgerr("Inefficient assignment");
- if(DECL_P(dest) && DECL_NAME(dest))
- {
- dbgerr(" Destination is %s", IDENTIFIER_POINTER(DECL_NAME(dest)));
- }
- dbgerr(" dest type is %s%s", show_type(dest_type), p2 ? "_P" : "");
- if(DECL_P(source) && DECL_NAME(source))
- {
- dbgerr(" Source is %s", IDENTIFIER_POINTER(DECL_NAME(source)));
- }
- dbgerr(" source type is %s%s", show_type(source_type), p2 ? "_P" : "");
- gcc_assert(false);
+ dbgerr(" Destination is %s", IDENTIFIER_POINTER(DECL_NAME(dest)));
}
-
- // The C equivalent would be "dest = source"
- // Note that we cast the source to the type of the dest
- tree stmt = build2_loc( location_from_lineno(),
- MODIFY_EXPR,
- TREE_TYPE(dest),
- dest,
- gg_cast(TREE_TYPE(dest), source)
- );
- gg_append_statement(stmt);
+ dbgerr(" dest type is %s%s", show_type(dest_type), p2 ? "_P" : "");
+ if(DECL_P(source) && DECL_NAME(source))
+ {
+ dbgerr(" Source is %s", IDENTIFIER_POINTER(DECL_NAME(source)));
+ }
+ dbgerr(" source type is %s%s", show_type(source_type), p2 ? "_P" : "");
+ gcc_assert(false);
}
}
diff --git a/gcc/cobol/gengen.h b/gcc/cobol/gengen.h
index 0d29d62cd62f5f4c56ced119dbfe77078c070305..ea4e9c9034dd7349720cf4dc45d204da773b8aa6 100644
--- a/gcc/cobol/gengen.h
+++ b/gcc/cobol/gengen.h
@@ -263,23 +263,23 @@ extern struct cbl_translation_unit_t gg_trans_unit;
#define current_function (&gg_trans_unit.function_stack.back())
-extern tree char_nodes[256] GTY(());
-extern tree pvoid_type_node GTY(());
-extern tree integer_minusone_node GTY(());
-extern tree integer_two_node GTY(());
-extern tree integer_eight_node GTY(());
-extern tree size_t_zero_node GTY(());
-extern tree int128_zero_node GTY(());
-extern tree int128_five_node GTY(());
-extern tree int128_ten_node GTY(());
-extern tree bool_true_node GTY(());
-extern tree bool_false_node GTY(());
-extern tree char_ptr_type_node GTY(());
-extern tree uchar_ptr_type_node GTY(());
-extern tree wchar_ptr_type_node GTY(());
-extern tree long_double_ten_node GTY(());
-extern tree sizeof_size_t GTY(());
-extern tree sizeof_pointer GTY(());
+extern GTY(()) tree char_nodes[256] ;
+extern GTY(()) tree pvoid_type_node ;
+extern GTY(()) tree integer_minusone_node;
+extern GTY(()) tree integer_two_node ;
+extern GTY(()) tree integer_eight_node ;
+extern GTY(()) tree size_t_zero_node ;
+extern GTY(()) tree int128_zero_node ;
+extern GTY(()) tree int128_five_node ;
+extern GTY(()) tree int128_ten_node ;
+extern GTY(()) tree bool_true_node ;
+extern GTY(()) tree bool_false_node ;
+extern GTY(()) tree char_ptr_type_node ;
+extern GTY(()) tree uchar_ptr_type_node ;
+extern GTY(()) tree wchar_ptr_type_node ;
+extern GTY(()) tree long_double_ten_node ;
+extern GTY(()) tree sizeof_size_t ;
+extern GTY(()) tree sizeof_pointer ;
// These routines happen when beginning to process a new file, which is also
// known, in GCC, as a "translation unit"
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 54f7a0b91e9c47bab575969ccf967c84c09ca55f..c58a34c3d159a0519f57867fae8abaf96e910ec6 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -1801,14 +1801,6 @@ set_exception_code_func(ec_type_t ec, int line, int from_raise_statement)
gg_printf("set_exception_code: set it to ZERO\n", NULL_TREE);
gg_assign(var_decl_exception_code, integer_zero_node);
}
- if( getenv("SHOW_EC") )
- {
- gg_printf("set_exception_code(0x%x) %s at line %d\n",
- build_int_cst_type(INT, (ec)),
- gg_string_literal(ec_type_str(ec)),
- build_int_cst_type(INT, line),
- NULL_TREE);
- }
}
bool
diff --git a/gcc/cobol/structs.cc b/gcc/cobol/structs.cc
index 82ae717649f046b49535c380cf816b2fe07b9ddc..a8e96ad11617e0019c0878341ec0f2b6c1a8e623 100644
--- a/gcc/cobol/structs.cc
+++ b/gcc/cobol/structs.cc
@@ -157,11 +157,8 @@ 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_resolved_p_type_node;
tree cblc_goto_type_node;
-tree cblc_goto_p_type_node;
tree cblc_int128_type_node;
-tree cblc_subscript_type_node;
// The following functions return type_decl nodes for the various structures
@@ -349,7 +346,6 @@ create_our_type_nodes()
cblc_file_type_node = create_cblc_file_t();
cblc_file_p_type_node = build_pointer_type(cblc_file_type_node);
cblc_int128_type_node = create_cblc_int128_t();
- cblc_subscript_type_node = create_cblc_subscript_t();
}
}
diff --git a/gcc/cobol/structs.h b/gcc/cobol/structs.h
index af0cd60e67be91deb5b559bd39eb47cf61be0049..618d8f0780f46c4fbfd9cc59b779cb468ca889c1 100644
--- a/gcc/cobol/structs.h
+++ b/gcc/cobol/structs.h
@@ -49,16 +49,13 @@ extern void member2(tree var, const char *member_name, const char *submember, in
extern void member2(tree var, const char *member_name, const char *submember, tree value);
extern void member3(tree var, const char *mem, const char *sub1, const char *sub2, tree value);
-extern tree cblc_field_type_node;
-extern tree cblc_field_p_type_node;
-extern tree cblc_field_pp_type_node;
-extern tree cblc_file_type_node;
-extern tree cblc_file_p_type_node;
-extern tree cblc_resolved_p_type_node;
-extern tree cblc_goto_type_node;
-extern tree cblc_goto_p_type_node;
-extern tree cblc_int128_type_node;
-extern tree cblc_subscript_type_node;
+extern GTY(()) tree cblc_field_type_node;
+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_goto_type_node;
+extern GTY(()) tree cblc_int128_type_node;
extern void create_our_type_nodes();