Skip to content

Fixes for C23 #229

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
ddeclerck wants to merge 1 commit into
base: gcos4gnucobol-3.x
Choose a base branch
from
Open

Fixes for C23 #229

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
216 changes: 118 additions & 98 deletions cobc/codegen.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -144,6 +144,7 @@ struct static_call_list {
const char *call_name;
int convention;
int return_type;
cb_tree args;
};

struct base_list {
Expand Down Expand Up @@ -298,6 +299,8 @@ static void codegen_finalize (void);

static void output_perform_once (struct cb_perform *);

static void output_function_arg_types (cb_tree args);

/* Local functions */

static struct cb_field *
Expand Down Expand Up @@ -385,7 +388,7 @@ lookup_func_call (const char *p)
}

static void
lookup_static_call (const char *p, int convention, int return_type)
lookup_static_call (const char *p, int convention, int return_type, cb_tree args)
{
struct static_call_list *sclp;

Expand All @@ -398,6 +401,7 @@ lookup_static_call (const char *p, int convention, int return_type)
sclp->call_name = p;
sclp->convention = convention;
sclp->return_type = return_type;
sclp->args = args;
sclp->next = static_call_cache;
Comment on lines 402 to 405
Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch May 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Not checked, mostly wondering: Should the above code in the loop do anything with the args or other parameters? (an hour later) We should have all of that already done in the compiler when we build and compare the internal prototype - which should be what we use here.
Thinking of it... the internal prototype should have convention, return_type and arg list within a structure, maybe that exists and can be used here, maybe it should be added...

Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch Jul 28, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@ddeclerck Can you check that, please?
If we can pass the prototype instead of its components "return type" + "args", we should do so.

Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch Jul 29, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ping @ddeclerck - also for the other review comments and cobc/Changelog

Copy link
Copy Markdown
Collaborator Author

@ddeclerck ddeclerck Jul 29, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

pong ;)
I wrote that a while ago and that seemed to make sense back then.
I'd need some time to dive back into this - but with the current failure on test 27, I don't even know how much this is going to change.

static_call_cache = sclp;
}
Expand Down Expand Up @@ -1890,6 +1894,8 @@ output_call_cache (void)
}
if (static_call_cache) {
const char *convention_modifier;
FILE *savetarget = output_target;
Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch May 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Zhe code below uses output_local only and that goes to cb_local_file - What did I miss?

Copy link
Copy Markdown
Collaborator Author

@ddeclerck ddeclerck May 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Below we call output_function_arg_types, which may output either to the "local" file (when outputting function definitions) or to the "main" file (when outputing casts in actual code).

Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch Jul 28, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please add a comment on line 1898 that we switch that for the output_function_arg_types call.

output_target = current_prog->local_include->local_fp;
static_call_cache = static_call_list_reverse (static_call_cache);
output_local ("/* Define external subroutines being called statically */\n");
for (static_call = static_call_cache; static_call;
Expand All @@ -1901,17 +1907,20 @@ output_call_cache (void)
}
output_local ("#ifndef %s\n", static_call->call_name);
if (static_call->return_type == COB_RETURN_NULL) {
output_local ("extern void %s%s ();\n", convention_modifier,
output_local ("extern void %s%s ", convention_modifier,
static_call->call_name);
} else if (static_call->return_type == COB_RETURN_ADDRESS_OF) {
output_local ("extern void * %s%s ();\n", convention_modifier,
output_local ("extern void * %s%s ", convention_modifier,
static_call->call_name);
} else {
output_local ("extern int %s%s ();\n", convention_modifier,
output_local ("extern int %s%s ", convention_modifier,
static_call->call_name);
}
output_function_arg_types (static_call->args);
output_local (";\n");
output_local ("#endif\n");
}
output_target = savetarget;
}
needs_unifunc = 0;
}
Expand Down Expand Up @@ -3910,10 +3919,24 @@ output_param (cb_tree x, int id)
cb_statement_enum_name[STMT_BEFORE_UDF]);
}
#if 0 /* RXWRXW Func */
output ("cob_user_function (func_%s, &cob_dyn_%u, ",
output ("cob_user_function (func_%s, &cob_dyn_%u",
func, gen_dynamic);
#else
output ("func_%s.funcfld (&cob_dyn_%u",
output ("((cob_field *(*)(cob_field **");
if (ip->intr_field) {
output (", ");
if (ip->intr_field == cb_int0) {
output ("void *");
} else if (ip->intr_field == cb_int1) {
output ("unsigned int");
} else {
output ("cob_field *");
}
}
for (l = ip->args; l; l = CB_CHAIN (l)) {
output (", cob_field *");
}
output ("))func_%s.funcfld) (&cob_dyn_%u",
func, gen_dynamic);
#endif
gen_dynamic++;
Expand Down Expand Up @@ -6592,6 +6615,87 @@ output_memory_check_call (struct cb_call *p, const enum cob_statement stmt)
}
}

static void
output_function_arg_types (cb_tree args)
{
cb_tree x;
Comment on lines +6618 to +6621
Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch Jul 28, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

new function, so please add a doxygen-style comment here as well

cb_tree l;
cob_u32_t n;

if (args) {
output ("(");
} else {
output ("(void)");
}
for (l = args, n = 1; l; l = CB_CHAIN (l), n++) {
x = CB_VALUE (l);
field_iteration = n - 1U;
switch (CB_PURPOSE_INT (l)) {
case CB_CALL_BY_REFERENCE:
case CB_CALL_BY_CONTENT:
output ("void *");
break;
case CB_CALL_BY_VALUE:
output_call_protocast (x, l);
break;
default:
break;
}
if (CB_CHAIN (l)) {
output (", ");
}
}
if (args) {
output (")");
}
}

static void
output_function_cast (struct cb_call *p, size_t ret_ptr, const char *convention, const char *name_str)
Comment on lines +6653 to +6654
Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch May 13, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this new (partially extracted) function should definitely get a good doxygen-style comment

{
output_prefix ();
if (ret_ptr) {
Copy link
Copy Markdown
Collaborator

@GitMensch GitMensch May 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ret_ptr should never have been a size_t, please fix that here and in the callers

#ifdef COB_NON_ALIGNED
output ("temptr");
#else
output_integer (p->call_returning);
#endif
output (" = ((void *(*)");
} else if (p->call_returning == cb_null) {
output ("((void (*)");
} else if (p->call_returning) {
output ("ret = ((int (*)");
} else if (p->convention & CB_CONV_NO_RET_UPD
|| !current_prog->cb_return_code) {
output ("((int (*)");
} else {
output_integer (current_prog->cb_return_code);
output (" = ((int (*)");
}
output_function_arg_types (p->args);
output(")");
if (p->call_returning == cb_null) {
if (name_str) {
output ("call_%s.funcnull%s", name_str, convention);
} else {
output ("cob_unifunc.funcnull%s", convention);
}
} else if (ret_ptr) {
if (name_str) {
output ("call_%s.funcptr%s", name_str, convention);
} else {
output ("cob_unifunc.funcptr%s", convention);
}
} else {
if (name_str) {
output ("call_%s.funcint%s", name_str, convention);
} else {
output ("cob_unifunc.funcint%s", convention);
}
}
output (")");
}

static void
output_call (struct cb_call *p)
{
Expand Down Expand Up @@ -6955,25 +7059,7 @@ output_call (struct cb_call *p)
output_integer (p->name);
output (";");
output_newline ();
output_prefix ();
if (p->call_returning == cb_null) {
output ("cob_unifunc.funcnull");
} else if (ret_ptr) {
#ifdef COB_NON_ALIGNED
output ("temptr");
#else
output_integer (p->call_returning);
#endif
output (" = cob_unifunc.funcptr");
} else if (p->call_returning) {
output ("ret = cob_unifunc.funcint");
} else if (p->convention & CB_CONV_NO_RET_UPD
|| !current_prog->cb_return_code) {
output ("(void)cob_unifunc.funcint");
} else {
output_integer (current_prog->cb_return_code);
output (" = cob_unifunc.funcint");
}
output_function_cast (p, ret_ptr, "", NULL);
} else if (!dynamic_link) {
/* Static link */
if (p->call_returning != cb_null) {
Expand Down Expand Up @@ -7007,13 +7093,14 @@ output_call (struct cb_call *p)
nlp->nested_prog->toplev_count);
} else {
output ("%s", name_str);
if (cb_flag_c_decl_for_static_call) {
if (cb_flag_c_decl_for_static_call &&
!cb_find_defined_program_by_name (name_str)) {
if (p->call_returning == cb_null) {
lookup_static_call (name_str, p->convention, COB_RETURN_NULL);
lookup_static_call (name_str, p->convention, COB_RETURN_NULL, p->args);
} else if (ret_ptr == 1) {
lookup_static_call (name_str, p->convention, COB_RETURN_ADDRESS_OF);
lookup_static_call (name_str, p->convention, COB_RETURN_ADDRESS_OF, p->args);
} else {
lookup_static_call (name_str, p->convention, COB_RETURN_INT);
lookup_static_call (name_str, p->convention, COB_RETURN_INT, p->args);
}
}
}
Expand All @@ -7031,7 +7118,7 @@ output_call (struct cb_call *p)

nlp = find_nested_prog_with_id (name_str);
if (nlp) {
output ("call_%s.funcint = %s_%d__;",
output ("call_%s.funcint = (int (*)(void))%s_%d__;",
name_str, name_str,
nlp->nested_prog->toplev_count);
} else {
Expand Down Expand Up @@ -7072,74 +7159,7 @@ output_call (struct cb_call *p)
output_line ("else");
output_block_open ();
}
output_prefix ();
/* call frame cast prototype */
if (ret_ptr) {
#ifdef COB_NON_ALIGNED
output ("temptr");
#else
output_integer (p->call_returning);
#endif
output (" = ((void *(*)");
} else if (p->call_returning == cb_null) {
output ("((void (*)");
} else if (p->call_returning) {
output ("ret = ((int (*)");
} else if (p->convention & CB_CONV_NO_RET_UPD
|| !current_prog->cb_return_code) {
output ("((int (*)");
} else {
output_integer (current_prog->cb_return_code);
output (" = ((int (*)");
}
if (p->args) {
output ("(");
} else {
output ("(void)");
}
for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) {
x = CB_VALUE (l);
field_iteration = n - 1U;
switch (CB_PURPOSE_INT (l)) {
case CB_CALL_BY_REFERENCE:
case CB_CALL_BY_CONTENT:
output ("void *");
break;
case CB_CALL_BY_VALUE:
output_call_protocast (x, l);
break;
default:
break;
}
if (CB_CHAIN (l)) {
output (", ");
}
}
if (p->args) {
output (")");
}
output(")");

if (p->call_returning == cb_null) {
if (name_str) {
output ("call_%s.funcnull%s", name_str, convention);
} else {
output ("cob_unifunc.funcnull%s", convention);
}
} else if (ret_ptr) {
if (name_str) {
output ("call_%s.funcptr%s", name_str, convention);
} else {
output ("cob_unifunc.funcptr%s", convention);
}
} else {
if (name_str) {
output ("call_%s.funcint%s", name_str, convention);
} else {
output ("cob_unifunc.funcint%s", convention);
}
}
output (")");
output_function_cast (p, ret_ptr, convention, name_str);
}

/* Arguments */
Expand Down
5 changes: 3 additions & 2 deletions libcob/call.c
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
/*
Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc.
Copyright (C) 2003-2012, 2014-2023, 2025 Free Software Foundation, Inc.
Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman

This file is part of GnuCOBOL.
Expand Down Expand Up @@ -1402,7 +1402,8 @@ cob_call (const char *name, const int argc, void **argv)
cobglobptr->cob_call_params = argc;
for (i = 0; i < argc; ++i) {
pargv[i] = argv[i];
} funcint = (int (*)(
}
funcint = (int (*)(
void *, void *, void *, void *
,void *, void *, void *, void *
,void *, void *, void *, void *
Expand Down
4 changes: 2 additions & 2 deletions tests/testsuite.src/used_binaries.at
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1163,9 +1163,9 @@ AT_DATA([prog3.cob], [
])

# static build with correct function signature
AT_CHECK([$COMPILE_MODULE -I . -fstatic-call prog3.cob], [0], [], [], [
AT_CHECK([$COMPILE_MODULE -I . -fstatic-call -fno-gen-c-decl-static-call prog3.cob], [0], [], [], [
# Previous test "failed" --> retry with import library
AT_CHECK([$COMPILE_MODULE -I . -fstatic-call -L. -lfilec prog3.cob], [0], ignore, ignore)]
AT_CHECK([$COMPILE_MODULE -I . -fstatic-call -L. -lfilec -fno-gen-c-decl-static-call prog3.cob], [0], ignore, ignore)]
)

AT_CLEANUP
Expand Down
Loading