diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 570cfb08ae913281184bbf148fa9969d54734b75..428885fd2c7bfbb58574cc21073e0a6f3dc67ade 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -4729,6 +4729,16 @@ static
tree
field_type_to_tree_type(cbl_field_t *field)
{
+ /* This routine is used to determine what action is taken with type of a
+ CALL ... USING <var> and the matching PROCEDURE DIVISION USING <var> of
+ a PROGRAM-ID or FUNCTION-ID
+
+ This routine looks at a field. If that field can be handled as a simple
+ type of no more than 64-bits, the tree form of that type is is returned.
+
+ */
+
+
// This maps a Fldxxx to a C-style variable type:
switch(field->type)
{
@@ -10647,7 +10657,8 @@ parser_call( cbl_refer_t name,
size_t narg,
cbl_ffi_arg_t args[],
cbl_label_t *except,
- cbl_label_t *not_except )
+ cbl_label_t *not_except,
+ bool is_function)
{
SHOW_PARSE
{
diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h
index cac09aa5ab3f7c57d893747735901e4b9a317634..fe13e65f884a20dd8b70fbbc24363a484561572d 100644
--- a/gcc/cobol/genapi.h
+++ b/gcc/cobol/genapi.h
@@ -570,10 +570,12 @@ size_t parser_call_target_update( size_t caller,
void parser_file_stash( struct cbl_file_t *file );
-void parser_call( cbl_refer_t name, cbl_refer_t returning,
- size_t narg, cbl_ffi_arg_t args[],
- cbl_label_t *except,
- cbl_label_t *not_except );
+void parser_call( cbl_refer_t name,
+ cbl_refer_t returning,
+ size_t narg, cbl_ffi_arg_t args[],
+ cbl_label_t *except,
+ cbl_label_t *not_except,
+ bool is_function);
void parser_entry_activate( size_t iprog, const cbl_label_t *declarative );
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 0eb68fc4271e43a346fd8a9d5df3f0a7e6618e58..ac05b969dab37c93da96968835162ee2609b9497 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -7706,7 +7706,7 @@ call_impl: CALL call_body[body]
pargs = use_list(params, args);
}
parser_call( *$body.ffi_name,
- *$body.ffi_returning, narg, pargs, NULL, NULL );
+ *$body.ffi_returning, narg, pargs, NULL, NULL, false );
current.declaratives_evaluate();
}
;
@@ -7721,7 +7721,7 @@ call_cond: CALL call_body[body] call_excepts[except]
}
parser_call( *$body.ffi_name,
*$body.ffi_returning, narg, pargs,
- $except.on_error, $except.not_error );
+ $except.on_error, $except.not_error, false );
auto handled = ec_type_t( static_cast<size_t>(ec_program_e) |
static_cast<size_t>(ec_external_e));
current.declaratives_evaluate(handled);
@@ -8329,7 +8329,7 @@ function_udf: FUNCTION_UDF '(' udf_args[args] ')' {
return cbl_ffi_arg_t(ar); } );
auto name = new_literal(L->name, quoted_e);
- parser_call( name, $$, narg, args, NULL, NULL );
+ parser_call( name, $$, narg, args, NULL, NULL, true );
}
| FUNCTION_UDF_0 {
static const size_t narg = 0;
@@ -8341,7 +8341,7 @@ function_udf: FUNCTION_UDF '(' udf_args[args] ')' {
$$ = new_temporary_clone(returning_as);
auto name = new_literal(L->name, quoted_e);
- parser_call( name, $$, narg, args, NULL, NULL );
+ parser_call( name, $$, narg, args, NULL, NULL, true );
}
;
udf_args: %empty { static refer_list_t empty(NULL); $$ = ∅ }
@@ -9366,7 +9366,8 @@ cdf_call_convention:
void parser_call2( cbl_refer_t name, cbl_refer_t returning,
size_t narg, cbl_ffi_arg_t args[],
cbl_label_t *except,
- cbl_label_t *not_except )
+ cbl_label_t *not_except,
+ bool is_function)
{
if( is_literal(name.field) ) {
cbl_field_t called = { 0, FldLiteralA, FldInvalid, quoted_e | constant_e,
@@ -9394,7 +9395,7 @@ void parser_call2( cbl_refer_t name, cbl_refer_t returning,
i, crv, args[i].refer.field, args[i].refer.field->name);
}
}
- parser_call( name, returning, narg, args, except, not_except );
+ parser_call( name, returning, narg, args, except, not_except, is_function );
}
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 0849760cb07267c8dc27a258bfa94e2b13e09d40..931748d7e0fcab01175aaed105c2f346e954a1bf 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -1386,7 +1386,7 @@ static class current_t {
yyerrorv("not implemented: Global declarative %s for %s",
eval->name, name);
parser_call( new_literal(name, quoted_e),
- cbl_refer_t(), 0, NULL, NULL, NULL );
+ cbl_refer_t(), 0, NULL, NULL, NULL, false );
}
}
@@ -1699,7 +1699,7 @@ static class current_t {
parser_entry_activate( iprog, eval );
auto name = cbl_label_of(symbol_at(iprog))->name;
parser_call( new_literal(name, quoted_e),
- cbl_refer_t(), 0, NULL, NULL, NULL );
+ cbl_refer_t(), 0, NULL, NULL, NULL, false );
}
}
}
@@ -2748,10 +2748,11 @@ file_section_parent_set( cbl_field_t *field ) {
void parser_call2( cbl_refer_t name, cbl_refer_t returning,
size_t narg, cbl_ffi_arg_t args[],
cbl_label_t *except,
- cbl_label_t *not_except );
+ cbl_label_t *not_except,
+ bool is_function );
-#define parser_call( name, returning, narg, args, except, not_except ) \
- parser_call2(name, returning, narg, args, except, not_except )
+#define parser_call( name, returning, narg, args, except, not_except, is_function ) \
+ parser_call2(name, returning, narg, args, except, not_except, is_function )
cbl_field_t *
ast_file_status_between( file_status_t lower, file_status_t upper );