https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119364
--- Comment #14 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
--- gcc/cobol/structs.h.jj 2025-03-28 20:34:01.659747026 +0100
+++ gcc/cobol/structs.h 2025-04-08 16:20:56.436127535 +0200
@@ -54,6 +54,7 @@ extern GTY(()) tree cblc_field_p_type_no
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();
--- gcc/cobol/structs.cc.jj 2025-04-07 21:10:11.385496862 +0200
+++ gcc/cobol/structs.cc 2025-04-08 16:21:34.775594364 +0200
@@ -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();
}
}
--- gcc/cobol/genapi.cc.jj 2025-04-07 21:10:24.645312313 +0200
+++ gcc/cobol/genapi.cc 2025-04-08 18:20:55.691518519 +0200
@@ -13295,24 +13295,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);
-
- static size_t prior_narg = 0;
- static size_t max_narg = 128;
- static unsigned char *prior_p = (unsigned char *)xmalloc(max_narg);
+ 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_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;
@@ -13325,13 +13330,15 @@ stash_exceptions( const cbl_enabled_exce
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;
@@ -13349,12 +13356,33 @@ stash_exceptions( const cbl_enabled_exce
TREE_TYPE(constr) = array_of_chars_type;
TREE_STATIC(constr) = 1;
TREE_CONSTANT(constr) = 1;
+ unsigned char *q = XALLOCAVEC(unsigned char, sz);
- for(size_t i=0; i<narg; i++)
+ for(size_t i=0; i<nec; i++)
{
- CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(constr),
- build_int_cst_type(SIZE_T, i),
- build_int_cst_type(UCHAR, p[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;
is WIP, this brings the declarative_1.cob.007t.gimple changes 64-bit cobol1 vs.
cross 32-bit -> 64-bit cobol1 down to a single variable from many.
Now on to the last one.
