diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index cfe62b579d6fbc1b8e7eb64cee739f72ae7f40fe..a65b0d1a6ea692a830f2d06d4deed75088315f2c 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 0f7b0ed739ebec99dccce6b62d8170712803c402..9c779326d7574229ece49527fa5cb0b9d308092a 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 a11ffcbd0e5bacd33f7f3f0ebe0d96dc5d772739..9ef5dfad6378652d598e927ad301bb3dd19ad9be 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