cobol: Eliminate cobolworx UAT errors when compiling with -Os

Testcases compiled with -Os were failing because static functions and static
variables were being optimized away, because of improper data type casts, and
because strict aliasing (whatever that is) was resulting in some loss of data.
These changes eliminate those known problems.

gcc/cobol

	* cobol1.cc: (cobol_langhook_post_options): Implemented in order to set
	flag_strict_aliasing to zero.
	* genapi.cc: (set_user_status): Add comment.
	(parser_intrinsic_subst): Expand SHOW_PARSE information.
	(psa_global): Change names of return-code and upsi globals,
	(psa_FldLiteralA): Set DECL_PRESERVE_P for FldLiteralA.
	* gengen.cc: (show_type): Add POINTER type.
	(gg_define_function_with_no_parameters): Set DECL_PRESERVE_P for COBOL-
	style nested programs.  (gg_array_of_bytes): Fix bad cast.

libgcobol

	* charmaps.h: Change __gg__data_return_code to 'short' type.
	* constants.cc: Likewise.

diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index 0d07c460d4161172e6fb98b9c26a7c2cfdd1b295..d175ab11e3f2f094838de4b0d1c6577c42adb3be 100644 (file)
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -646,6 +646,22 @@ cobol_get_sarif_source_language(const char *)
     return "cobol";
     }
 
+bool
+cobol_langhook_post_options(const char**)
+  {
+  // This flag, when set to 0, results in calls to gg_exit working properly.
+  // I don't know why it is necessary.  There is something going on with the
+  // definition of  __gg__data_return_code in constants.cc, and with how it
+  // is used through var_decl_return_code in genapi.cc.  Without it, the value
+  // delivered to exit@PLT is zero, and not __gg__data_return_code
+  // Dubner, 2025-04-04.
+  flag_strict_aliasing = 0;
+
+  /* Returning false means that the backend should be used.  */
+  return false;
+  }
+
+
 #undef LANG_HOOKS_BUILTIN_FUNCTION
 #undef LANG_HOOKS_GETDECLS
 #undef LANG_HOOKS_GLOBAL_BINDINGS_P
@@ -660,6 +676,7 @@ cobol_get_sarif_source_language(const char *)
 ////#undef LANG_HOOKS_TYPE_FOR_SIZE
 #undef LANG_HOOKS_SET_DECL_ASSEMBLER_NAME
 #undef LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE
+#undef LANG_HOOKS_POST_OPTIONS
 
 // We use GCC in the name, not GNU, as others do,
 // because "GnuCOBOL" refers to a different GNU project.
@@ -685,6 +702,8 @@ cobol_get_sarif_source_language(const char *)
 
 #define LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE cobol_get_sarif_source_language
 
+#define LANG_HOOKS_POST_OPTIONS cobol_langhook_post_options
+
 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
 #include "gt-cobol-cobol1.h"

diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index a0da6476e2a891ff259b847bfd3a896409ac369e..fbe0bbc75dc831b87231efbaeed2dc7bcc4752b8 100644 (file)
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -8806,6 +8806,10 @@ static
 void set_user_status(struct cbl_file_t *file)
   {
   // This routine sets the user_status, if any, to the cblc_file_t::status
+
+  // We have to do it this way, because in the case where the file->user_status
+  // is in linkage, the memory addresses can end up pointing to the wrong
+  // places
   if(file->user_status)
     {
     cbl_field_t *user_status = cbl_field_of(symbol_at(file->user_status));
@@ -10111,6 +10115,13 @@ parser_intrinsic_subst( cbl_field_t *f,
   SHOW_PARSE
     {
     SHOW_PARSE_HEADER
+    SHOW_PARSE_FIELD(" TO ", f)
+    for(size_t i=0; i<argc; i++)
+      {
+      SHOW_PARSE_INDENT
+      SHOW_PARSE_FIELD(" ", argv[i].orig.field)
+      SHOW_PARSE_FIELD(" ", argv[i].replacement.field)
+      }
     SHOW_PARSE_END
     }
   TRACE1
@@ -15908,12 +15919,12 @@ psa_global(cbl_field_t *new_var)
 
   if( strcmp(new_var->name, "RETURN-CODE") == 0 )
     {
-    strcpy(ach, "__gg___11_return_code6");
+    strcpy(ach, "__gg__return_code");
     }
 
   if( strcmp(new_var->name, "UPSI-0") == 0 )
     {
-    strcpy(ach, "__gg___6_upsi_04");
+    strcpy(ach, "__gg__upsi");
     }
 
   new_var->var_decl_node = gg_declare_variable(cblc_field_type_node, ach, NULL, vs_external_reference);
@@ -16156,6 +16167,10 @@ psa_FldLiteralA(struct cbl_field_t *field )
                 field->data.initial,
                 NULL_TREE,
                 field->var_decl_node);
+    TREE_READONLY(field->var_decl_node) = 1;
+    TREE_USED(field->var_decl_node) = 1;
+    TREE_STATIC(field->var_decl_node) = 1;
+    DECL_PRESERVE_P (field->var_decl_node) = 1;
     nvar += 1;
     }
   TRACE1

diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc
index ffb64c8993d912b6deb98c6965c8784d5d52972c..e7a4e3c51653a95341084fe753816723859dfc61 100644 (file)
--- a/gcc/cobol/gengen.cc
+++ b/gcc/cobol/gengen.cc
@@ -375,6 +375,10 @@ show_type(tree type)
   static char ach[1024];
   switch( TREE_CODE(type) )
     {
+    case POINTER_TYPE:
+      sprintf(ach, "POINTER");
+      break;
+
     case VOID_TYPE:
       sprintf(ach, "VOID");
       break;
@@ -2548,6 +2552,10 @@ gg_define_function_with_no_parameters(tree return_type,
     DECL_CONTEXT (function_decl) = gg_trans_unit.trans_unit_decl;
     TREE_PUBLIC(function_decl) = 0;
 
+    // This function is file static, but nobody calls it, so without
+    // intervention -O1+ optimizations will discard it.
+    DECL_PRESERVE_P (function_decl) = 1;
+
     // Append this function to the list of functions and variables
     // associated with the computation module.
     gg_append_var_decl(function_decl);
@@ -3358,8 +3366,8 @@ gg_array_of_size_t( size_t N, size_t *values)
 tree
 gg_array_of_bytes( size_t N, unsigned char *values)
   {
-  tree retval = gg_define_variable(build_pointer_type(UCHAR));
-  gg_assign(retval, gg_cast(build_pointer_type(UCHAR), gg_malloc(  build_int_cst_type(UCHAR, N * sizeof(unsigned char)))));
+  tree retval = gg_define_variable(UCHAR_P);
+  gg_assign(retval, gg_cast(UCHAR_P, gg_malloc(  build_int_cst_type(SIZE_T, N * sizeof(unsigned char)))));
   for(size_t i=0; i<N; i++)
     {
     gg_assign(gg_array_value(retval, i), build_int_cst_type(UCHAR, values[i]));

diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h
index 12968fdf9282a1a52288bd8fc8c3f49fb47f3656..6b4e9f5c4b4967e68c73a74228ce61c14517aed7 100644 (file)
--- a/libgcobol/charmaps.h
+++ b/libgcobol/charmaps.h
@@ -297,7 +297,7 @@ extern unsigned char __gg__data_zeros[1]       ;
 extern unsigned char __gg__data_high_values[1] ;
 extern unsigned char __gg__data_quotes[1]      ;
 extern unsigned char __gg__data_upsi_0[2]      ;
-extern unsigned char __gg__data_return_code[2] ;
+extern short         __gg__data_return_code    ;
 
 // These are the various hardcoded tables used for conversions.
 extern const unsigned short __gg__one_to_one_values[256];

diff --git a/libgcobol/constants.cc b/libgcobol/constants.cc
index 026f919cacc34424f1aed69b4112f6354ed18fe0..d37c791f1b3582281c190e8192a2ba841b76921a 100644 (file)
--- a/libgcobol/constants.cc
+++ b/libgcobol/constants.cc
@@ -288,7 +288,7 @@ struct cblc_field_t __gg___14_linage_counter6 = {
 
 
 unsigned char __gg__data_upsi_0[2] = {0,0};
-struct cblc_field_t __gg___6_upsi_04 = {
+struct cblc_field_t __gg__upsi = {
   .data           = __gg__data_upsi_0 ,
   .capacity       = 2 ,
   .allocated      = 2 ,
@@ -307,9 +307,9 @@ struct cblc_field_t __gg___6_upsi_04 = {
   .dummy          = 0 ,
   };
 
-unsigned char __gg__data_return_code[2] = {0,0};
-struct cblc_field_t __gg___11_return_code6 = {
-  .data           = __gg__data_return_code ,
+short __gg__data_return_code = 0;
+struct cblc_field_t __gg__return_code = {
+  .data           = (unsigned char *)&__gg__data_return_code ,
   .capacity       = 2 ,
   .allocated      = 2 ,
   .offset         = 0 ,
@@ -319,7 +319,7 @@ struct cblc_field_t __gg___11_return_code6 = {
   .parent         = NULL,
   .occurs_lower   = 0 ,
   .occurs_upper   = 0 ,
-  .attr           = 0x0 ,
+  .attr           = signable_e ,
   .type           = FldNumericBin5 ,
   .level          = 0 ,
   .digits         = 4 ,