cobol: Fix up exception handling [PR119364]

The following patch on top of the
https://gcc.gnu.org/pipermail/gcc-patches/2025-May/682500.html
fixes most of the remaining make check-cobol FAILs in the
i686-linux -> x86_64-linux cross-compiler.

Using the testing environment detailed in
https://gcc.gnu.org/pipermail/gcc-patches/2025-April/680403.html
with this patch I get just cobol.dg/group1/declarative_1.cob FAILs
in i686-linux -> x86_64-linux cross and no FAILs in x86_64-linux
native one.

The patch isn't needed just for cross-compilation with different
hosts, but also on x86_64-linux/aarch64-linux native, because without
it the FE is hashing padding bits which contain random garbage and making
code generation decisions based on that.  That is very much against the
reproduceability requirements.

2025-05-02  Jakub Jelinek  <jakub@redhat.com>

	PR cobol/119364
	* structs.h (cbl_enabled_exception_type_node): New variable
	declaration.
	* structs.cc (cbl_enabled_exception_type_node): New variable.
	(create_cbl_enabled_exception_t): New function.
	(create_our_type_nodes): Initialize cbl_enabled_exception_type_node
	using it.
	* genapi.cc (stash_exceptions): Don't compare padding bits to
	determine if the exceptions are the same as last time.  Use
	cbl_enabled_exception_type_node for target size and field offsets
	and native_encode_expr to write each field into byte sequence.

(cherry picked from commit c77d04506e6abdc45969d0ff146204be7485244a)

diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index eba10b0bdfe3ecbf2a6f2880e84aec28df025be9..dca52ce080d5324a80ba09e919323a19c3772a4c 100644 (file)
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -13301,24 +13301,29 @@ static void
 stash_exceptions( const cbl_enabled_exceptions_array_t *enabled )
   {
   // We need to create a static array of bytes
-  size_t narg = enabled->nbytes();
-  unsigned char *p = (unsigned char *)(enabled->ecs);
+  size_t nec = enabled->nec;
+  size_t sz = int_size_in_bytes(cbl_enabled_exception_type_node);
+  size_t narg = nec * sz;
+  cbl_enabled_exception_t *p = enabled->ecs;
 
-  static size_t prior_narg = 0;
-  static size_t max_narg   = 128;
-  static unsigned char *prior_p = (unsigned char *)xmalloc(max_narg);
+  static size_t prior_nec = 0;
+  static size_t max_nec   = 0;
+  static cbl_enabled_exception_t *prior_p;
 
   bool we_got_new_data = false;
-  if( prior_narg != narg )
+  if( prior_nec != nec )
     {
     we_got_new_data = true;
     }
   else
     {
-    // The narg counts are the same.
-    for(size_t i=0; i<narg; i++)
+    // The nec counts are the same.
+    for(size_t i=0; i<nec; i++)
       {
-      if( p[i] != prior_p[i] )
+      if( p[i].enabled != prior_p[i].enabled
+          || p[i].location != prior_p[i].location
+          || p[i].ec != prior_p[i].ec
+          || p[i].file != prior_p[i].file )
         {
         we_got_new_data = true;
         break;
@@ -13331,13 +13336,15 @@ stash_exceptions( const cbl_enabled_exceptions_array_t *enabled )
     return;
     }
 
-  if( narg > max_narg )
+  if( nec > max_nec )
     {
-    max_narg = narg;
-    prior_p = (unsigned char *)xrealloc(prior_p, max_narg);
+    max_nec = nec;
+    prior_p = (cbl_enabled_exception_t *)
+              xrealloc(prior_p, max_nec * sizeof(cbl_enabled_exception_t));
     }
 
-  memcpy(prior_p, p, narg);
+  memcpy((unsigned char *)prior_p, (unsigned char *)p,
+         nec * sizeof(cbl_enabled_exception_t));
 
   static int count = 1;
 
@@ -13355,12 +13362,33 @@ stash_exceptions( const cbl_enabled_exceptions_array_t *enabled )
     TREE_TYPE(constr) = array_of_chars_type;
     TREE_STATIC(constr)    = 1;
     TREE_CONSTANT(constr)  = 1;
-
-    for(size_t i=0; i<narg; i++)
-      {
-      CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(constr),
-                              build_int_cst_type(SIZE_T, i),
-                              build_int_cst_type(UCHAR, p[i]));
+    unsigned char *q = XALLOCAVEC(unsigned char, sz);
+
+    for(size_t i=0; i<nec; i++)
+      {
+      memset(q, '\0', sz);
+      tree enabled = constant_boolean_node(p[i].enabled, BOOL);
+      tree location = constant_boolean_node(p[i].location, BOOL);
+      tree ec = build_int_cst(UINT, p[i].ec);
+      tree file = build_int_cst(SIZE_T, p[i].file);
+      tree fld = TYPE_FIELDS(cbl_enabled_exception_type_node);
+      native_encode_expr(enabled, q + tree_to_uhwi(byte_position(fld)),
+                         int_size_in_bytes(BOOL));
+      fld = TREE_CHAIN(fld);
+      native_encode_expr(location, q + tree_to_uhwi(byte_position(fld)),
+                         int_size_in_bytes(BOOL));
+      fld = TREE_CHAIN(fld);
+      native_encode_expr(ec, q + tree_to_uhwi(byte_position(fld)),
+                         int_size_in_bytes(UINT));
+      fld = TREE_CHAIN(fld);
+      native_encode_expr(file, q + tree_to_uhwi(byte_position(fld)),
+                         int_size_in_bytes(SIZE_T));
+      for(size_t j=0; j<sz; j++)
+        {
+        CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(constr),
+                                build_int_cst_type(SIZE_T, i*sz + j),
+                                build_int_cst_type(UCHAR, q[j]));
+        }
       }
     array_of_chars = gg_define_variable(array_of_chars_type, ach, vs_static);
     DECL_INITIAL(array_of_chars) = constr;

diff --git a/gcc/cobol/structs.cc b/gcc/cobol/structs.cc
index 134edbddfa374e531e2cb73940a5edc552fe2f9e..6192486076073f5f440ce0746d4da8eba0a9e51c 100644 (file)
--- a/gcc/cobol/structs.cc
+++ b/gcc/cobol/structs.cc
@@ -156,6 +156,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 cbl_enabled_exception_type_node;
 tree cblc_goto_type_node;
 
 // The following functions return type_decl nodes for the various structures
@@ -285,6 +286,29 @@ typedef struct cblc_file_t
     return retval;
     }
 
+static tree
+create_cbl_enabled_exception_t()
+    {
+    /*
+    struct cbl_enabled_exception_t
+        {
+        bool enabled, location;
+        ec_type_t ec;
+        size_t file;
+        };
+    */
+    tree retval = NULL_TREE;
+    retval = gg_get_filelevel_struct_type_decl( "cbl_enabled_exception_t",
+                                            4,
+                                            BOOL,   "enabled",
+                                            BOOL,   "location",
+                                            UINT,   "ec",
+                                            SIZE_T, "file");
+    retval = TREE_TYPE(retval);
+
+    return retval;
+    }
+
 void
 create_our_type_nodes()
     {
@@ -297,6 +321,7 @@ create_our_type_nodes()
         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);
+        cbl_enabled_exception_type_node   = create_cbl_enabled_exception_t();
         }
     }
 

diff --git a/gcc/cobol/structs.h b/gcc/cobol/structs.h
index 47a78b45e9a81f78451797e98f5e54c8826fc382..1a16523dcb6be570e2fdf20aad02e6362e37940a 100644 (file)
--- 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 cbl_enabled_exception_type_node;
 extern GTY(()) tree cblc_goto_type_node;
 
 extern void create_our_type_nodes();