From 2efe32ecae33853d281ff1b753939838ed9fe0f7 Mon Sep 17 00:00:00 2001
From: Bob Dubner <rdubner@symas.com>
Date: Mon, 1 Jan 2024 11:38:31 -0500
Subject: [PATCH] We have ignition on generalized RETURNING
---
gcc/cobol/genapi.cc | 10 +++++++---
gcc/cobol/gengen.cc | 16 ++++++++++++----
gcc/cobol/gengen.h | 1 +
3 files changed, 20 insertions(+), 7 deletions(-)
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index cfe62b579d6f..a65b0d1a6ea6 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -717,7 +717,7 @@ function_handle_from_name(cbl_refer_t &name,
tree unmangled_name = gg_define_char_star();
tree mangled_name = gg_define_char_star();
- gg_assign(unmangled_name, gg_call_expr( CHAR_P,
+ gg_assign(unmangled_name, gg_call_expr( CHAR_P,
"__gg__name_not_mangled",
1,
gg_get_address_of(name.refer_decl_node)));
@@ -835,7 +835,7 @@ function_handle_from_name(cbl_refer_t &name,
// If it's a literal, call the target literally using the
// undecorated name. At END-PROGRAM, the parser will replace
// in-scope plain names with mangled names.
- if( use_static_call() && is_literal(name.field) )
+ if( use_static_call() && is_literal(name.field) )
{
// A literal name is always "found". We create a reference to
// it, which is later resolved by the linker.
@@ -4891,6 +4891,10 @@ parser_exit(void)
tree return_type = tree_type_from_field_type(current_function->returning,
nbytes);
tree retval = gg_define_variable(return_type);
+
+ gg_modify_function_type(current_function->function_decl,
+ return_type);
+
if( is_numeric( field_type ) )
{
// The field being returned is numeric.
@@ -4918,7 +4922,6 @@ parser_exit(void)
gg_get_address_of(value),
build_int_cst_type(SIZE_T, nbytes));
}
-
gg_return(retval);
}
else
@@ -10516,6 +10519,7 @@ parser_call( cbl_refer_t name,
size_t nbytes;
tree returned_value_type = tree_type_from_field_type(returned.field, nbytes);
+
if(returned.field)
{
// we were given a returned::field, so find its location and length:
diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc
index 0f7b0ed739eb..9c779326d757 100644
--- a/gcc/cobol/gengen.cc
+++ b/gcc/cobol/gengen.cc
@@ -632,10 +632,6 @@ gg_start_building_a_union(const char *type_name, tree type_context)
return typedecl;
}
-
-
-
-
static tree
gg_start_building_a_struct(const char *type_name, tree type_context)
{
@@ -2629,6 +2625,18 @@ chain_parameter_to_function(tree function_decl, const tree param_type, const ch
}
}
+void
+gg_modify_function_type(tree function_decl, tree return_type)
+ {
+ tree fndecl_type = build_varargs_function_type_array( return_type,
+ 0, // No parameters yet
+ NULL); // And, hence, no types
+ TREE_TYPE(function_decl) = fndecl_type;
+ tree resdecl = build_decl (UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE, return_type);
+ DECL_CONTEXT (resdecl) = function_decl;
+ DECL_RESULT (function_decl) = resdecl;
+ }
+
tree
gg_define_function_with_no_parameters(tree return_type,
const char *funcname,
diff --git a/gcc/cobol/gengen.h b/gcc/cobol/gengen.h
index a11ffcbd0e5b..9ef5dfad6378 100644
--- a/gcc/cobol/gengen.h
+++ b/gcc/cobol/gengen.h
@@ -541,4 +541,5 @@ tree gg_open(tree char_star_A, tree int_B);
tree gg_close(tree int_A);
tree gg_get_indirect_reference(tree pointer, tree offset);
void gg_insert_into_assembler(const char *format, ...);
+void gg_modify_function_type(tree function_decl, tree return_type);
#endif
--
GitLab