diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 9a856652c5ef514882751387fb43a290ccc03dc3..92eb0deeaa5944fdfc40ab956b7e54cd912d8a82 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -5386,6 +5386,13 @@ parser_division(cbl_division_t division,
// means that we didn't assign any storage to them during
// parser_symbol_add(). We do that here.
+ // We actually create two variables. The first behaves like a LOCAL-STORAGE
+ // variable, because we need to handle the possibility of the return value
+ // having to survive recursive calls. The second one is static storage; the
+ // LOCAL-STORAGE stack variable gets copied to the static one at return time
+ // so that the caller isn't trying to copy from a stack variable that has
+ // disappeared.
+
if( returning && !returning->data_decl_node )
{
char achDataName[256];
@@ -5393,7 +5400,7 @@ parser_division(cbl_division_t division,
tree array_type = build_array_type_nelts(UCHAR, returning->data.capacity);
returning->data_decl_node = gg_define_variable( array_type,
- achDataName,
+ NULL,
vs_static);
gg_assign( member(returning->var_decl_node, "data"),
gg_get_address_of(returning->data_decl_node) );
@@ -5497,16 +5504,11 @@ parser_division(cbl_division_t division,
if( args[i].crv == by_value_e )
{
// 'parameter' is the 64-bit value that was placed on the stack
- // 'parameter' is the 64-bit value that was placed on the stack
cbl_field_t *new_var = args[i].refer.field;
- // We need to allocate memory for it.
- char achDataName[256];
- sprintf(achDataName, "..vardata_%lu", sv_data_name_counter++);
-
tree array_type = build_array_type_nelts(UCHAR, new_var->data.capacity);
tree data_decl_node = gg_define_variable( array_type,
- achDataName,
+ NULL,
vs_stack);
gg_assign( member(new_var->var_decl_node, "data"),
gg_get_address_of(data_decl_node) );
@@ -14338,17 +14340,12 @@ parser_local_add(struct cbl_field_t *new_var )
if( new_var->level == LEVEL01 || new_var->level == LEVEL77 )
{
// We need to allocate memory on the stack for this variable
- char achDataName[256];
- sprintf(achDataName, "..vardata_%lu", sv_data_name_counter++);
- //fprintf(stderr, "compile-time local name is %s\n", achDataName);
-
tree array_type = build_array_type_nelts(UCHAR, new_var->data.capacity);
tree data_decl_node = gg_define_variable( array_type,
NULL,
vs_stack);
gg_assign( member(new_var->var_decl_node, "data"),
gg_get_address_of(data_decl_node) );
- //gg_printf("run-time local name is %s %p\n", gg_string_literal(achDataName), gg_get_address_of(data_decl_node), NULL_TREE);
}
cbl_refer_t wrapper;
wrapper.field = new_var;
diff --git a/gcc/cobol/gengen.h b/gcc/cobol/gengen.h
index 1f65ac9dbe234ced38c7ddf612b62fe3c7ed145a..11b1cc00f277f32fda178de8966c2f01c5787259 100644
--- a/gcc/cobol/gengen.h
+++ b/gcc/cobol/gengen.h
@@ -195,7 +195,8 @@ struct gg_function_t
// When parser_division(PROCEDURE) is called, it provides a cbl_field_t
// *returning parameter. We stash it here; it's used during parser_exit()
// to provide the data for the program's return value.
- cbl_field_t *returning;
+ cbl_field_t *returner; // This one is statically allocated
+ cbl_field_t *returning; // This one is on the stack, like a LOCAL-STORAGE
// When a function is defined as having formal parameters (that is, there
// is a USING clause in the function definition), we need to convert
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index cb3fd7ef64ac2eb45bd2e17049c80f929a4695b8..1f30c936e88eb613af1acf6658fd17de3d935460 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -91,8 +91,6 @@ tree var_decl_exit_address; // This is for implementing pseudo_return_
tree var_decl_call_parameter_count; // int __gg__call_parameter_count
tree var_decl_call_parameter_lengths; // size_t *__gg__call_parameter_count
-
-
int
get_scaled_rdigits(cbl_field_t *field)
{
diff --git a/gcc/cobol/genutil.h b/gcc/cobol/genutil.h
index f2c13d3c6efe16684588c4483a1e1b9315b710c5..8c85c9fa17d79827233ca3f9a09e40b1d3f1e16c 100644
--- a/gcc/cobol/genutil.h
+++ b/gcc/cobol/genutil.h
@@ -66,7 +66,7 @@ extern tree var_decl_entry_location; // This is for managing ENTRY state
extern tree var_decl_exit_address; // This is for implementing pseudo_return_pop
extern tree var_decl_call_parameter_count; // int __gg__call_parameter_count
-extern tree var_decl_call_parameter_lengths; // size_t *__gg__call_parameter_count
+extern tree var_decl_call_parameter_lengths; // size_t *var_decl_call_parameter_lengths
int get_scaled_rdigits(cbl_field_t *field);
int get_scaled_digits(cbl_field_t *field);
diff --git a/gcc/cobol/show_parse.h b/gcc/cobol/show_parse.h
index 911890cffb13372cee3810da2e66830a1f21afe9..12e030307b8b215a66c04a113fa71c21361d50a8 100644
--- a/gcc/cobol/show_parse.h
+++ b/gcc/cobol/show_parse.h
@@ -207,6 +207,11 @@ extern bool cursor_at_sol;
parser_display_internal_field(trace_handle, field, false); \
gg_fprintf(trace_handle, 1, "\" %s", gg_string_literal(b)); \
} \
+ else if( field->type == FldLiteral ) \
+ { \
+ gg_fprintf(trace_handle, 1, "%s [", gg_string_literal(a)); \
+ gg_fprintf(trace_handle, 1, "] %s", gg_string_literal(b)); \
+ } \
else \
{ \
gg_fprintf(trace_handle, 1, "%s [", gg_string_literal(a)); \
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 61840d99cf681cf5dd6375a4d4fce2677ea5c3e1..7c6bab358aef591a2bef8f6443a82f08a5d8f15a 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -99,6 +99,7 @@ static const char *stashed_exception_source_file;
static int stashed_exception_line_number;
static const char *stashed_exception_statement;
+
int __gg__call_parameter_count = A_ZILLION;
static int sv_from_raise_statement = 0;
@@ -3945,8 +3946,6 @@ __gg__initialize_variable(cblc_refer_t *var_ref,
// Make a copy of the field pointer we're working with as a convenience:
cblc_field_t *var = var_ref->field;
- // fprintf(stderr, "__gg__initialize_variable %s\n", var->name);
-
// Set the "initialized" bit, which is tested in parser_symbol_add to make
// sure this code gets executed only once.
var->attr |= initialized_e;
@@ -6607,11 +6606,21 @@ __gg__display( cblc_refer_t *var,
fprintf(stderr, "__gg__display of arg %p\n", var->qual_data);
}
- format_for_display_internal(&display_string,
- &display_string_size,
- var->field,
- var->qual_data,
- var->qual_size );
+ // if( var->qual_data )
+ // {
+ format_for_display_internal(&display_string,
+ &display_string_size,
+ var->field,
+ var->qual_data,
+ var->qual_size );
+ // }
+ // else
+ // {
+ // // This can happen during TRACE1=2 with LOCAL=STORAGE
+ // char achmsg[] = "<NULL>";
+ // strcpy(display_string, achmsg);
+ // display_string_size = strlen(display_string);
+ // }
// Let's honor the locale of the system, as best we can:
static size_t converted_size = MINIMUM_ALLOCATION_SIZE;
@@ -6622,6 +6631,18 @@ __gg__display( cblc_refer_t *var,
ssize_t ss = write( file_descriptor,
converted,
strlen(converted));
+ if(ss == -1)
+ {
+ fprintf(stderr, "__gg__display() %s %p\n", var->field->name, var->qual_data);
+ fprintf(stderr, "__gg__display() %zd\n", converted_size);
+ fprintf(stderr, "__gg__display() ");
+ for(size_t i=0; i<converted_size; i++)
+ {
+ fprintf(stderr, "%c(%2.2x) ", converted[i]<32 ? '?' : converted[i], converted[i]);
+ }
+ fprintf(stderr, "\n");
+ }
+
assert(ss != -1);
if( advance )