Skip to content

Commit 3b7bba2

Browse files
ddeclerckddeclerck
committed
Fixes for C23
1 parent d8bd3f3 commit 3b7bba2

File tree

2 files changed

+121
-100
lines changed

2 files changed

+121
-100
lines changed

‎cobc/codegen.c‎

Lines changed: 118 additions & 98 deletions
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,7 @@ struct static_call_list {
144144
const char *call_name;
145145
int convention;
146146
int return_type;
147+
cb_tree args;
147148
};
148149

149150
struct base_list {
@@ -298,6 +299,8 @@ static void codegen_finalize (void);
298299

299300
static void output_perform_once (struct cb_perform *);
300301

302+
static void output_function_arg_types (cb_tree args);
303+
301304
/* Local functions */
302305

303306
static struct cb_field *
@@ -385,7 +388,7 @@ lookup_func_call (const char *p)
385388
}
386389

387390
static void
388-
lookup_static_call (const char *p, int convention, int return_type)
391+
lookup_static_call (const char *p, int convention, int return_type, cb_tree args)
389392
{
390393
struct static_call_list *sclp;
391394

@@ -398,6 +401,7 @@ lookup_static_call (const char *p, int convention, int return_type)
398401
sclp->call_name = p;
399402
sclp->convention = convention;
400403
sclp->return_type = return_type;
404+
sclp->args = args;
401405
sclp->next = static_call_cache;
402406
static_call_cache = sclp;
403407
}
@@ -1890,6 +1894,8 @@ output_call_cache (void)
18901894
}
18911895
if (static_call_cache) {
18921896
const char *convention_modifier;
1897+
FILE *savetarget = output_target;
1898+
output_target = current_prog->local_include->local_fp;
18931899
static_call_cache = static_call_list_reverse (static_call_cache);
18941900
output_local ("/* Define external subroutines being called statically */\n");
18951901
for (static_call = static_call_cache; static_call;
@@ -1901,17 +1907,20 @@ output_call_cache (void)
19011907
}
19021908
output_local ("#ifndef %s\n", static_call->call_name);
19031909
if (static_call->return_type == COB_RETURN_NULL) {
1904-
output_local ("extern void %s%s ();\n", convention_modifier,
1910+
output_local ("extern void %s%s ", convention_modifier,
19051911
static_call->call_name);
19061912
} else if (static_call->return_type == COB_RETURN_ADDRESS_OF) {
1907-
output_local ("extern void * %s%s ();\n", convention_modifier,
1913+
output_local ("extern void * %s%s ", convention_modifier,
19081914
static_call->call_name);
19091915
} else {
1910-
output_local ("extern int %s%s ();\n", convention_modifier,
1916+
output_local ("extern int %s%s ", convention_modifier,
19111917
static_call->call_name);
19121918
}
1919+
output_function_arg_types (static_call->args);
1920+
output_local (";\n");
19131921
output_local ("#endif\n");
19141922
}
1923+
output_target = savetarget;
19151924
}
19161925
needs_unifunc = 0;
19171926
}
@@ -3910,10 +3919,24 @@ output_param (cb_tree x, int id)
39103919
cb_statement_enum_name[STMT_BEFORE_UDF]);
39113920
}
39123921
#if 0 /* RXWRXW Func */
3913-
output ("cob_user_function (func_%s, &cob_dyn_%u, ",
3922+
output ("cob_user_function (func_%s, &cob_dyn_%u",
39143923
func, gen_dynamic);
39153924
#else
3916-
output ("func_%s.funcfld (&cob_dyn_%u",
3925+
output ("((cob_field *(*)(cob_field **");
3926+
if (ip->intr_field) {
3927+
output (", ");
3928+
if (ip->intr_field == cb_int0) {
3929+
output ("void *");
3930+
} else if (ip->intr_field == cb_int1) {
3931+
output ("unsigned int");
3932+
} else {
3933+
output ("cob_field *");
3934+
}
3935+
}
3936+
for (l = ip->args; l; l = CB_CHAIN (l)) {
3937+
output (", cob_field *");
3938+
}
3939+
output ("))func_%s.funcfld) (&cob_dyn_%u",
39173940
func, gen_dynamic);
39183941
#endif
39193942
gen_dynamic++;
@@ -6592,6 +6615,87 @@ output_memory_check_call (struct cb_call *p, const enum cob_statement stmt)
65926615
}
65936616
}
65946617

6618+
static void
6619+
output_function_arg_types (cb_tree args)
6620+
{
6621+
cb_tree x;
6622+
cb_tree l;
6623+
cob_u32_t n;
6624+
6625+
if (args) {
6626+
output ("(");
6627+
} else {
6628+
output ("(void)");
6629+
}
6630+
for (l = args, n = 1; l; l = CB_CHAIN (l), n++) {
6631+
x = CB_VALUE (l);
6632+
field_iteration = n - 1U;
6633+
switch (CB_PURPOSE_INT (l)) {
6634+
case CB_CALL_BY_REFERENCE:
6635+
case CB_CALL_BY_CONTENT:
6636+
output ("void *");
6637+
break;
6638+
case CB_CALL_BY_VALUE:
6639+
output_call_protocast (x, l);
6640+
break;
6641+
default:
6642+
break;
6643+
}
6644+
if (CB_CHAIN (l)) {
6645+
output (", ");
6646+
}
6647+
}
6648+
if (args) {
6649+
output (")");
6650+
}
6651+
}
6652+
6653+
static void
6654+
output_function_cast (struct cb_call *p, size_t ret_ptr, const char *convention, const char *name_str)
6655+
{
6656+
output_prefix ();
6657+
if (ret_ptr) {
6658+
#ifdef COB_NON_ALIGNED
6659+
output ("temptr");
6660+
#else
6661+
output_integer (p->call_returning);
6662+
#endif
6663+
output (" = ((void *(*)");
6664+
} else if (p->call_returning == cb_null) {
6665+
output ("((void (*)");
6666+
} else if (p->call_returning) {
6667+
output ("ret = ((int (*)");
6668+
} else if (p->convention & CB_CONV_NO_RET_UPD
6669+
|| !current_prog->cb_return_code) {
6670+
output ("((int (*)");
6671+
} else {
6672+
output_integer (current_prog->cb_return_code);
6673+
output (" = ((int (*)");
6674+
}
6675+
output_function_arg_types (p->args);
6676+
output(")");
6677+
if (p->call_returning == cb_null) {
6678+
if (name_str) {
6679+
output ("call_%s.funcnull%s", name_str, convention);
6680+
} else {
6681+
output ("cob_unifunc.funcnull%s", convention);
6682+
}
6683+
} else if (ret_ptr) {
6684+
if (name_str) {
6685+
output ("call_%s.funcptr%s", name_str, convention);
6686+
} else {
6687+
output ("cob_unifunc.funcptr%s", convention);
6688+
}
6689+
} else {
6690+
if (name_str) {
6691+
output ("call_%s.funcint%s", name_str, convention);
6692+
} else {
6693+
output ("cob_unifunc.funcint%s", convention);
6694+
}
6695+
}
6696+
output (")");
6697+
}
6698+
65956699
static void
65966700
output_call (struct cb_call *p)
65976701
{
@@ -6955,25 +7059,7 @@ output_call (struct cb_call *p)
69557059
output_integer (p->name);
69567060
output (";");
69577061
output_newline ();
6958-
output_prefix ();
6959-
if (p->call_returning == cb_null) {
6960-
output ("cob_unifunc.funcnull");
6961-
} else if (ret_ptr) {
6962-
#ifdef COB_NON_ALIGNED
6963-
output ("temptr");
6964-
#else
6965-
output_integer (p->call_returning);
6966-
#endif
6967-
output (" = cob_unifunc.funcptr");
6968-
} else if (p->call_returning) {
6969-
output ("ret = cob_unifunc.funcint");
6970-
} else if (p->convention & CB_CONV_NO_RET_UPD
6971-
|| !current_prog->cb_return_code) {
6972-
output ("(void)cob_unifunc.funcint");
6973-
} else {
6974-
output_integer (current_prog->cb_return_code);
6975-
output (" = cob_unifunc.funcint");
6976-
}
7062+
output_function_cast (p, ret_ptr, "", NULL);
69777063
} else if (!dynamic_link) {
69787064
/* Static link */
69797065
if (p->call_returning != cb_null) {
@@ -7007,13 +7093,14 @@ output_call (struct cb_call *p)
70077093
nlp->nested_prog->toplev_count);
70087094
} else {
70097095
output ("%s", name_str);
7010-
if (cb_flag_c_decl_for_static_call) {
7096+
if (cb_flag_c_decl_for_static_call &&
7097+
!cb_find_defined_program_by_name (name_str)) {
70117098
if (p->call_returning == cb_null) {
7012-
lookup_static_call (name_str, p->convention, COB_RETURN_NULL);
7099+
lookup_static_call (name_str, p->convention, COB_RETURN_NULL, p->args);
70137100
} else if (ret_ptr == 1) {
7014-
lookup_static_call (name_str, p->convention, COB_RETURN_ADDRESS_OF);
7101+
lookup_static_call (name_str, p->convention, COB_RETURN_ADDRESS_OF, p->args);
70157102
} else {
7016-
lookup_static_call (name_str, p->convention, COB_RETURN_INT);
7103+
lookup_static_call (name_str, p->convention, COB_RETURN_INT, p->args);
70177104
}
70187105
}
70197106
}
@@ -7031,7 +7118,7 @@ output_call (struct cb_call *p)
70317118

70327119
nlp = find_nested_prog_with_id (name_str);
70337120
if (nlp) {
7034-
output ("call_%s.funcint = %s_%d__;",
7121+
output ("call_%s.funcint = (int (*)(void))%s_%d__;",
70357122
name_str, name_str,
70367123
nlp->nested_prog->toplev_count);
70377124
} else {
@@ -7072,74 +7159,7 @@ output_call (struct cb_call *p)
70727159
output_line ("else");
70737160
output_block_open ();
70747161
}
7075-
output_prefix ();
7076-
/* call frame cast prototype */
7077-
if (ret_ptr) {
7078-
#ifdef COB_NON_ALIGNED
7079-
output ("temptr");
7080-
#else
7081-
output_integer (p->call_returning);
7082-
#endif
7083-
output (" = ((void *(*)");
7084-
} else if (p->call_returning == cb_null) {
7085-
output ("((void (*)");
7086-
} else if (p->call_returning) {
7087-
output ("ret = ((int (*)");
7088-
} else if (p->convention & CB_CONV_NO_RET_UPD
7089-
|| !current_prog->cb_return_code) {
7090-
output ("((int (*)");
7091-
} else {
7092-
output_integer (current_prog->cb_return_code);
7093-
output (" = ((int (*)");
7094-
}
7095-
if (p->args) {
7096-
output ("(");
7097-
} else {
7098-
output ("(void)");
7099-
}
7100-
for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) {
7101-
x = CB_VALUE (l);
7102-
field_iteration = n - 1U;
7103-
switch (CB_PURPOSE_INT (l)) {
7104-
case CB_CALL_BY_REFERENCE:
7105-
case CB_CALL_BY_CONTENT:
7106-
output ("void *");
7107-
break;
7108-
case CB_CALL_BY_VALUE:
7109-
output_call_protocast (x, l);
7110-
break;
7111-
default:
7112-
break;
7113-
}
7114-
if (CB_CHAIN (l)) {
7115-
output (", ");
7116-
}
7117-
}
7118-
if (p->args) {
7119-
output (")");
7120-
}
7121-
output(")");
7122-
7123-
if (p->call_returning == cb_null) {
7124-
if (name_str) {
7125-
output ("call_%s.funcnull%s", name_str, convention);
7126-
} else {
7127-
output ("cob_unifunc.funcnull%s", convention);
7128-
}
7129-
} else if (ret_ptr) {
7130-
if (name_str) {
7131-
output ("call_%s.funcptr%s", name_str, convention);
7132-
} else {
7133-
output ("cob_unifunc.funcptr%s", convention);
7134-
}
7135-
} else {
7136-
if (name_str) {
7137-
output ("call_%s.funcint%s", name_str, convention);
7138-
} else {
7139-
output ("cob_unifunc.funcint%s", convention);
7140-
}
7141-
}
7142-
output (")");
7162+
output_function_cast (p, ret_ptr, convention, name_str);
71437163
}
71447164

71457165
/* Arguments */

‎libcob/call.c‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
/*
2-
Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc.
2+
Copyright (C) 2003-2012, 2014-2023, 2025 Free Software Foundation, Inc.
33
Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman
44
55
This file is part of GnuCOBOL.
@@ -1402,7 +1402,8 @@ cob_call (const char *name, const int argc, void **argv)
14021402
cobglobptr->cob_call_params = argc;
14031403
for (i = 0; i < argc; ++i) {
14041404
pargv[i] = argv[i];
1405-
} funcint = (int (*)(
1405+
}
1406+
funcint = (int (*)(
14061407
void *, void *, void *, void *
14071408
,void *, void *, void *, void *
14081409
,void *, void *, void *, void *

0 commit comments

Comments
 (0)