diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 18e4ed2d0deca875347b7a20d898b5d678f8c1d7..a1c50628116c0831bd34ace1f66d19a9d21ee441 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -62,6 +62,8 @@
#include "valconv.h"
#include "show_parse.h"
+#define VS_REUSE vs_static
+
extern void print_gimple_nodes(const char *filename, tree root);
// This structure is returned by the parser_performxxx() routines, and gets
@@ -3711,20 +3713,8 @@ parser_symbol_add_FldLiteralN(struct cbl_field_t *field )
tree var_type;
- gg_variable_scope_t our_scope;
- if( field->attr & (intermediate_e | temporary_e) )
- {
- //our_scope = vs_stack;
- our_scope = vs_static;
- }
- else
- {
- our_scope = vs_static;
- }
-
if( field->data.capacity == 16 )
{
-
/* GCC-13 has no provision for an int128 constructor. So, we use a
union for our necessary __int128.
@@ -3774,7 +3764,7 @@ parser_symbol_add_FldLiteralN(struct cbl_field_t *field )
tree new_var_decl = gg_define_variable( var_type,
base_name,
- our_scope);
+ vs_static);
DECL_INITIAL(new_var_decl) = union_constructor;
field->data_decl_node = member(new_var_decl, "sval128");
@@ -3785,7 +3775,7 @@ parser_symbol_add_FldLiteralN(struct cbl_field_t *field )
sprintf(id_string, ".%ld", ++our_index);
strcpy(base_name, field->name);
strcat(base_name, id_string);
- field->literal_decl_node = gg_define_variable(DOUBLE, id_string, our_scope);
+ field->literal_decl_node = gg_define_variable(DOUBLE, id_string, vs_static);
TREE_READONLY(field->literal_decl_node) = 1;
TREE_CONSTANT(field->literal_decl_node) = 1;
char ach[128];
@@ -3803,7 +3793,7 @@ parser_symbol_add_FldLiteralN(struct cbl_field_t *field )
field->attr & signable_e);
tree new_var_decl = gg_define_variable( var_type,
base_name,
- our_scope);
+ vs_static);
DECL_INITIAL(new_var_decl) = build_int_cst_type(var_type, value);
field->data_decl_node = new_var_decl;
}
@@ -5125,11 +5115,6 @@ parser_exit(void)
// variable on the stack. We need to make a copy of it to avoid the
// error of returning a pointer to data on the stack.
- // Create a buffer that grows in size, as needed, to accommodate the
- // data that needs to be returned.
-
-#pragma GCC warning "Fix me: Create a buffer that grows in size"
-
tree array_type = build_array_type_nelts(UCHAR,
current_function->returning->data.capacity);
tree retval = gg_define_variable(array_type, vs_static);
@@ -5771,7 +5756,7 @@ parser_division(cbl_division_t division,
tree array_type = build_array_type_nelts(UCHAR, new_var->data.capacity);
tree data_decl_node = gg_define_variable( array_type,
NULL,
- vs_stack);
+ VS_REUSE);
gg_assign( member(new_var->var_decl_node, "data"),
gg_get_address_of(data_decl_node) );
@@ -14438,15 +14423,31 @@ psa_new_var_decl(cbl_field_t *new_var, const char *external_record_base)
}
else if( strlen(new_var->name) == 0 )
{
- // This happens with some FldLiteralA variables. For example, the
- // filename in a SELECT statement.
- static size_t literal_count = 1;
- sprintf(base_name, "%s_%zd", "_literal", literal_count++);
+ // This can happen.
+ static int empty_count = 1;
+ sprintf(base_name,
+ "_%s_%d",
+ cbl_field_type_str(new_var->type),
+ empty_count++);
+ }
+ else if( new_var->attr & intermediate_e )
+ {
+ static int inter_count = 1;
+ sprintf(base_name,
+ "_%s_%s_%d",
+ "intermediate",
+ new_var->name,
+ inter_count++);
}
- else if( new_var->attr & (temporary_e | intermediate_e) )
+ else if( new_var->attr & temporary_e
+ && !is_literal(new_var) )
{
- static size_t temp_count = 1;
- sprintf(base_name, "%s_%zd_%s", "_temporary_", temp_count++, new_var->name);
+ static int temp_count = 1;
+ sprintf(base_name,
+ "_%s_%s_%d",
+ "temporary",
+ new_var->name,
+ temp_count++);
}
else
{
@@ -14462,11 +14463,13 @@ psa_new_var_decl(cbl_field_t *new_var, const char *external_record_base)
base_name,
vs_external);
}
- else if( new_var->attr & (temporary_e | intermediate_e) )
+ else if( new_var->attr & (temporary_e | intermediate_e)
+ && new_var->type != FldLiteralA
+ && new_var->type != FldLiteralN )
{
new_var_decl = gg_define_variable( cblc_field_type_node,
base_name,
- vs_static); // vs_stack);
+ VS_REUSE);
}
else
{
@@ -14518,6 +14521,13 @@ parser_local_add(struct cbl_field_t *new_var )
void
parser_symbol_add(struct cbl_field_t *new_var )
{
+ if(new_var->var_decl_node)
+ {
+ fprintf(stderr, "possible reuse\n");
+ }
+
+
+
if( !(new_var->attr & initialized_e) )
{
cbl_field_type_t incoming_type = new_var->type;
@@ -14704,7 +14714,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
// a runtime copy of a structure for the variable; instead,
// var_decl_node becomes a boolean_type_node that is used directly.
sprintf(ach, "_%sconditional_%d", new_var->name, counter++);
- new_var->var_decl_node = gg_define_variable(BOOL, ach, vs_static);
+ new_var->var_decl_node = gg_define_variable(BOOL, ach, VS_REUSE);
return;
break;
@@ -15006,7 +15016,21 @@ parser_symbol_add(struct cbl_field_t *new_var )
{
// We need a unique name for the allocated data for this COBOL variable:
char achDataName[256];
- sprintf(achDataName, "_%s_data_%lu", new_var->name, sv_data_name_counter++);
+ if( new_var->name[0] == '_' )
+ {
+ // Avoid doubling up on leading underscore
+ sprintf(achDataName,
+ "%s_data_%lu",
+ new_var->name,
+ sv_data_name_counter++);
+ }
+ else
+ {
+ sprintf(achDataName,
+ "_%s_data_%lu",
+ new_var->name,
+ sv_data_name_counter++);
+ }
tree array_type = build_array_type_nelts(UCHAR, bytes_to_allocate);
new_var->data_decl_node = gg_define_variable(
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 6e82bb92fdbc2da6f8c767af760754c6fee2e068..803e0c2e97c5aedbab233d48ee4792ba085158d9 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -2431,12 +2431,7 @@ refer_fill_internal(cbl_refer_t &refer, refer_type_t refer_type)
refer.field ? refer.field->name : "noname",
counter++);
- //// Trying to switch the next statement to vs_stack rather than vs_static.
- //// That's a work in progress; at this time putting these on the stack results
- //// in intermittent errors. Apparently such data sometimes, but not always,
- //// gets lost before it is used. RJD 2024-04-07
- refer.refer_decl_node = gg_define_variable(cblc_refer_type_node, ach, vs_static);
-// refer.refer_decl_node = gg_define_variable(cblc_refer_type_node, ach, vs_stack);
+ refer.refer_decl_node = gg_define_variable(cblc_refer_type_node, ach, vs_stack);
gg_memset(gg_get_address_of(refer.refer_decl_node),
integer_zero_node,
build_int_cst_type(SIZE_T, sizeof(cblc_refer_t)));
@@ -2467,18 +2462,6 @@ refer_fill_internal(cbl_refer_t &refer, refer_type_t refer_type)
{
gg_assign(member(refer.refer_decl_node, "qual_data"),
gg_cast(UCHAR_P, member(refer.field->var_decl_node, "initial")));
-#if 0
- if( refer.field->attr & hex_encoded_e )
- {
- gg_assign(member(refer.refer_decl_node, "qual_size"),
- build_int_cst_type(SIZE_T, refer.field->data.capacity));
- }
- else
- {
- gg_assign(member(refer.refer_decl_node, "qual_size"),
- build_int_cst_type(SIZE_T, strlen(refer.field->data.initial)));
- }
-#endif
gg_assign(member(refer.refer_decl_node, "qual_size"),
build_int_cst_type(SIZE_T, refer.field->data.capacity));
}
@@ -2598,15 +2581,14 @@ build_array_of_cblc_refer( size_t N,
cbl_refer_t *refers)
{
// We create and populate an array of cblc_refer_t
-
static size_t cblc_refer_size = gg_sizeof(cblc_refer_type_node);
- tree refers_p = gg_define_variable(cblc_refer_p_type_node, vs_static);
- tree walker = gg_define_variable(cblc_refer_p_type_node, vs_static);
+ tree refers_p = gg_define_variable(cblc_refer_p_type_node, vs_stack);
+ tree walker = gg_define_variable(cblc_refer_p_type_node, vs_stack);
if( N )
{
- refers_p = gg_define_variable(cblc_refer_p_type_node, vs_static);
+ refers_p = gg_define_variable(cblc_refer_p_type_node, vs_stack);
gg_assign( refers_p,
gg_cast(cblc_refer_p_type_node, gg_malloc( N * cblc_refer_size)));
gg_assign( walker, refers_p);
@@ -2635,7 +2617,7 @@ build_array_of_cblc_size_t( size_t N,
size_t *values)
{
// We create and populate an array of size_t values
- tree values_p = gg_define_variable(build_pointer_type(SIZE_T), vs_static);
+ tree values_p = gg_define_variable(build_pointer_type(SIZE_T), vs_stack);
if( N )
{
gg_assign( values_p,
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 81798fc25315df5fb9d09aa80b788bc06c6d3840..2e57410eef7bbbad24c1ab792a594a61a7878f82 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -3020,7 +3020,11 @@ new_literal_add( const char initial[], uint32_t len, enum cbl_field_attr_t attr
}
static size_t literal_count = 1;
- sprintf(field->name, "%s_%zd", "_literal", literal_count++);
+ sprintf(field->name,
+ "%s%c_%zd",
+ "_literal",
+ field->type == FldLiteralA ? 'a' : 'n',
+ literal_count++);
return parser_symbol_add2(field);
}