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.

3 files changed, 73 insertions, 19 deletions

diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index eba10b0..dca52ce 100644
--- 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 134edbd..6192486 100644
--- 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 47a78b4..1a16523 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 cbl_enabled_exception_type_node;
 extern GTY(()) tree cblc_goto_type_node;
 
 extern void create_our_type_nodes();