Skip to content

Commit 4b0782f

Browse files
ddeclerckddeclerck
committed
Fixes for C23
1 parent 84359ec commit 4b0782f

File tree

3 files changed

+276
-102
lines changed

3 files changed

+276
-102
lines changed

‎cobc/codegen.c‎

Lines changed: 115 additions & 96 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
}
@@ -3908,7 +3917,21 @@ output_param (cb_tree x, int id)
39083917
output ("cob_user_function (func_%s, &cob_dyn_%u, ",
39093918
func, gen_dynamic);
39103919
#else
3911-
output ("func_%s.funcfld (&cob_dyn_%u",
3920+
output ("((cob_field *(*)(cob_field **");
3921+
if (ip->intr_field) {
3922+
output (", ");
3923+
if (ip->intr_field == cb_int0) {
3924+
output ("void *");
3925+
} else if (ip->intr_field == cb_int1) {
3926+
output ("unsigned int");
3927+
} else {
3928+
output ("cob_field *");
3929+
}
3930+
}
3931+
for (l = ip->args; l; l = CB_CHAIN (l)) {
3932+
output (", cob_field *");
3933+
}
3934+
output ("))func_%s.funcfld) (&cob_dyn_%u",
39123935
func, gen_dynamic);
39133936
#endif
39143937
gen_dynamic++;
@@ -6587,6 +6610,87 @@ output_memory_check_call (struct cb_call *p, const enum cob_statement stmt)
65876610
}
65886611
}
65896612

6613+
static void
6614+
output_function_arg_types (cb_tree args)
6615+
{
6616+
cb_tree x;
6617+
cb_tree l;
6618+
cob_u32_t n;
6619+
6620+
if (args) {
6621+
output ("(");
6622+
} else {
6623+
output ("(void)");
6624+
}
6625+
for (l = args, n = 1; l; l = CB_CHAIN (l), n++) {
6626+
x = CB_VALUE (l);
6627+
field_iteration = n - 1U;
6628+
switch (CB_PURPOSE_INT (l)) {
6629+
case CB_CALL_BY_REFERENCE:
6630+
case CB_CALL_BY_CONTENT:
6631+
output ("void *");
6632+
break;
6633+
case CB_CALL_BY_VALUE:
6634+
output_call_protocast (x, l);
6635+
break;
6636+
default:
6637+
break;
6638+
}
6639+
if (CB_CHAIN (l)) {
6640+
output (", ");
6641+
}
6642+
}
6643+
if (args) {
6644+
output (")");
6645+
}
6646+
}
6647+
6648+
static void
6649+
output_function_cast (struct cb_call *p, size_t ret_ptr, const char *convention, const char *name_str)
6650+
{
6651+
output_prefix ();
6652+
if (ret_ptr) {
6653+
#ifdef COB_NON_ALIGNED
6654+
output ("temptr");
6655+
#else
6656+
output_integer (p->call_returning);
6657+
#endif
6658+
output (" = ((void *(*)");
6659+
} else if (p->call_returning == cb_null) {
6660+
output ("((void (*)");
6661+
} else if (p->call_returning) {
6662+
output ("ret = ((int (*)");
6663+
} else if (p->convention & CB_CONV_NO_RET_UPD
6664+
|| !current_prog->cb_return_code) {
6665+
output ("((int (*)");
6666+
} else {
6667+
output_integer (current_prog->cb_return_code);
6668+
output (" = ((int (*)");
6669+
}
6670+
output_function_arg_types (p->args);
6671+
output(")");
6672+
if (p->call_returning == cb_null) {
6673+
if (name_str) {
6674+
output ("call_%s.funcnull%s", name_str, convention);
6675+
} else {
6676+
output ("cob_unifunc.funcnull%s", convention);
6677+
}
6678+
} else if (ret_ptr) {
6679+
if (name_str) {
6680+
output ("call_%s.funcptr%s", name_str, convention);
6681+
} else {
6682+
output ("cob_unifunc.funcptr%s", convention);
6683+
}
6684+
} else {
6685+
if (name_str) {
6686+
output ("call_%s.funcint%s", name_str, convention);
6687+
} else {
6688+
output ("cob_unifunc.funcint%s", convention);
6689+
}
6690+
}
6691+
output (")");
6692+
}
6693+
65906694
static void
65916695
output_call (struct cb_call *p)
65926696
{
@@ -6950,25 +7054,7 @@ output_call (struct cb_call *p)
69507054
output_integer (p->name);
69517055
output (";");
69527056
output_newline ();
6953-
output_prefix ();
6954-
if (p->call_returning == cb_null) {
6955-
output ("cob_unifunc.funcnull");
6956-
} else if (ret_ptr) {
6957-
#ifdef COB_NON_ALIGNED
6958-
output ("temptr");
6959-
#else
6960-
output_integer (p->call_returning);
6961-
#endif
6962-
output (" = cob_unifunc.funcptr");
6963-
} else if (p->call_returning) {
6964-
output ("ret = cob_unifunc.funcint");
6965-
} else if (p->convention & CB_CONV_NO_RET_UPD
6966-
|| !current_prog->cb_return_code) {
6967-
output ("(void)cob_unifunc.funcint");
6968-
} else {
6969-
output_integer (current_prog->cb_return_code);
6970-
output (" = cob_unifunc.funcint");
6971-
}
7057+
output_function_cast (p, ret_ptr, "", NULL);
69727058
} else if (!dynamic_link) {
69737059
/* Static link */
69747060
if (p->call_returning != cb_null) {
@@ -7004,11 +7090,11 @@ output_call (struct cb_call *p)
70047090
output ("%s", name_str);
70057091
if (cb_flag_c_decl_for_static_call) {
70067092
if (p->call_returning == cb_null) {
7007-
lookup_static_call (name_str, p->convention, COB_RETURN_NULL);
7093+
lookup_static_call (name_str, p->convention, COB_RETURN_NULL, p->args);
70087094
} else if (ret_ptr == 1) {
7009-
lookup_static_call (name_str, p->convention, COB_RETURN_ADDRESS_OF);
7095+
lookup_static_call (name_str, p->convention, COB_RETURN_ADDRESS_OF, p->args);
70107096
} else {
7011-
lookup_static_call (name_str, p->convention, COB_RETURN_INT);
7097+
lookup_static_call (name_str, p->convention, COB_RETURN_INT, p->args);
70127098
}
70137099
}
70147100
}
@@ -7026,7 +7112,7 @@ output_call (struct cb_call *p)
70267112

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

71407159
/* Arguments */

0 commit comments

Comments
 (0)