Skip to content
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.

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

Fix Bug 923: generated modules init/clear unused decimal constants #115

Closed
wants to merge 2 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
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
19 changes: 19 additions & 0 deletions cobc/ChangeLog
Original file line number Diff line number Diff line change
@@ -1,4 +1,23 @@

2023-10-17 David Declerck <david.declerck@ocamlpro.com>

BUG #923: generated modules init/clear unused decimal constants
* codegen.c (literal_list): removal of the unused x field,
and type moved to tree.h
* tree.h (struct cb_program): new decimal_constant field
to store decimal constants used by the current program,
* codegen.c (cb_cache_program_decimal_constant): new function
that adds constants used by the current program to the new
decimal_constant field in struct cb_prog
* codegen.c (cb_lookup_literal): added the current program as
argument to cb_lookup_literal to account for different
usage contexts (parse/typecheck vs codegen)
* codegen.c (output_internal_function): iterate over
prog->decimal_constants instead of literal_cache so as to only
output decimal constants actually used by the current program
* typeck.c (decimal_expand, cb_build_cond_fields),
codegen.c (output_param) : pass current_program to cb_lookup_literal

2023-07-26 Simon Sobisch <simonsobisch@gnu.org>

* typeck.c (search_set_keys): improving SEARCH ALL syntax checks
Expand Down
90 changes: 51 additions & 39 deletions cobc/codegen.c
Original file line number Diff line number Diff line change
Expand Up @@ -124,14 +124,6 @@ struct attr_list {
cob_u32_t flags;
};

struct literal_list {
struct literal_list *next;
struct cb_literal *literal;
cb_tree x;
int id;
int make_decimal;
};

struct field_list {
struct field_list *next;
struct cb_field *f;
Expand Down Expand Up @@ -2597,7 +2589,7 @@ output_literals_figuratives_and_constants (void)
#else
output ("static const cob_field %s%d\t= ",
CB_PREFIX_CONST, lit->id);
output_field (lit->x);
output_field (CB_TREE(lit->literal));
#endif
output (";");
output_newline ();
Expand Down Expand Up @@ -2763,8 +2755,32 @@ output_source_cache (void)

/* Literal */

/* Add the given literal to the list of "seen" decimal
constants in the given program "prog" */
static void
cb_cache_program_decimal_constant (struct cb_program *prog, struct literal_list *cached_literal)
{
struct literal_list *l;
for (l = prog->decimal_constants; l; l = l->next) {
if (cached_literal->id == l->id) {
return;
}
}

l = cobc_parse_malloc (sizeof (struct literal_list));
l->id = cached_literal->id;
l->literal = cached_literal->literal;
l->make_decimal = cached_literal->make_decimal;
l->next = prog->decimal_constants;
prog->decimal_constants = l;
}

/* Resolve literal "x" from the literal cache and return its id.
The literal is added to the literal cache if missing.
Additionally, if the literal is a decimal constant, it is
added to the list of "seen" decimal constant of program "prog". */
int
cb_lookup_literal (cb_tree x, int make_decimal)
cb_lookup_literal (struct cb_program *prog, cb_tree x, int make_decimal)
ddeclerck marked this conversation as resolved.
Show resolved Hide resolved
{
struct cb_literal *literal;
struct literal_list *l;
Expand All @@ -2781,6 +2797,7 @@ cb_lookup_literal (cb_tree x, int make_decimal)
(size_t)literal->size) == 0) {
if (make_decimal) {
l->make_decimal = 1;
cb_cache_program_decimal_constant (prog, l);
}
return l->id;
}
Expand All @@ -2794,9 +2811,11 @@ cb_lookup_literal (cb_tree x, int make_decimal)
l->id = cb_literal_id;
l->literal = literal;
l->make_decimal = make_decimal;
l->x = x;
l->next = literal_cache;
literal_cache = l;
if (make_decimal) {
cb_cache_program_decimal_constant (prog, l);
}

return cb_literal_id++;
}
Expand Down Expand Up @@ -3655,10 +3674,10 @@ output_param (cb_tree x, int id)
}
case CB_TAG_LITERAL:
if (nolitcast) {
output ("&%s%d", CB_PREFIX_CONST, cb_lookup_literal (x, 0));
output ("&%s%d", CB_PREFIX_CONST, cb_lookup_literal (current_prog, x, 0));
} else {
output ("(cob_field *)&%s%d", CB_PREFIX_CONST,
cb_lookup_literal (x, 0));
cb_lookup_literal (current_prog, x, 0));
}
break;
case CB_TAG_FIELD:
Expand Down Expand Up @@ -12601,21 +12620,18 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
}

seen = 0;
for (m = literal_cache; m; m = m->next) {
if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC
&& m->make_decimal) {
if (!seen) {
seen = 1;
output_line ("/* Set Decimal Constant values */");
}
output_line ("%s%d = &%s%d;", CB_PREFIX_DEC_CONST, m->id,
CB_PREFIX_DEC_FIELD, m->id);
output_line ("cob_decimal_init (%s%d);", CB_PREFIX_DEC_CONST, m->id);
output_line ("cob_decimal_set_field (%s%d, (cob_field *)&%s%d);",
CB_PREFIX_DEC_CONST, m->id,
CB_PREFIX_CONST, m->id);
output_newline ();
}
for (m = prog->decimal_constants; m; m = m->next) {
if (!seen) {
seen = 1;
output_line ("/* Set Decimal Constant values */");
}
output_line ("%s%d = &%s%d;", CB_PREFIX_DEC_CONST, m->id,
CB_PREFIX_DEC_FIELD, m->id);
output_line ("cob_decimal_init (%s%d);", CB_PREFIX_DEC_CONST, m->id);
output_line ("cob_decimal_set_field (%s%d, (cob_field *)&%s%d);",
CB_PREFIX_DEC_CONST, m->id,
CB_PREFIX_CONST, m->id);
output_newline ();
}
if (seen) {
output_newline ();
Expand Down Expand Up @@ -12809,16 +12825,13 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
output_newline ();
output_line ("P_clear_decimal:");
seen = 0;
for (m = literal_cache; m; m = m->next) {
if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC
&& m->make_decimal) {
if (!seen) {
seen = 1;
output_line ("/* Clear Decimal Constant values */");
}
output_line ("cob_decimal_clear (%s%d);", CB_PREFIX_DEC_CONST, m->id);
output_line ("%s%d = NULL;", CB_PREFIX_DEC_CONST, m->id);
for (m = prog->decimal_constants; m; m = m->next) {
if (!seen) {
seen = 1;
output_line ("/* Clear Decimal Constant values */");
}
output_line ("cob_decimal_clear (%s%d);", CB_PREFIX_DEC_CONST, m->id);
output_line ("%s%d = NULL;", CB_PREFIX_DEC_CONST, m->id);
}
if (seen) {
output_newline ();
Expand Down Expand Up @@ -13970,8 +13983,7 @@ codegen_finalize (void)
struct literal_list* m;
int comment_gen = 0;
for (m = literal_cache; m; m = m->next) {
if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC
&& m->make_decimal) {
if (m->make_decimal) {
if (!comment_gen) {
comment_gen = 1;
output_storage ("\n/* Decimal constants */\n");
Expand Down
10 changes: 9 additions & 1 deletion cobc/tree.h
Original file line number Diff line number Diff line change
Expand Up @@ -1794,6 +1794,13 @@ struct cb_ml_generate_tree {

/* Program */

struct literal_list {
struct literal_list *next;
struct cb_literal *literal;
int id;
int make_decimal;
};

struct nested_list {
struct nested_list *next;
struct cb_program *nested_prog;
Expand Down Expand Up @@ -1890,6 +1897,7 @@ struct cb_program {
unsigned char numeric_separator; /* ',' or '.' */
enum cob_module_type prog_type; /* Program type (program = 0, function = 1) */
cb_tree entry_convention; /* ENTRY convention / PROCEDURE convention */
struct literal_list *decimal_constants;

unsigned int flag_main : 1; /* Gen main function */
unsigned int flag_common : 1; /* COMMON PROGRAM */
Expand Down Expand Up @@ -2076,7 +2084,7 @@ extern cb_tree cb_concat_literals (const cb_tree,

extern cb_tree cb_build_decimal (const unsigned int);
extern cb_tree cb_build_decimal_literal (const int);
extern int cb_lookup_literal (cb_tree x, int make_decimal);
extern int cb_lookup_literal (struct cb_program *prog, cb_tree x, int make_decimal);

extern cb_tree cb_build_comment (const char *);
extern cb_tree cb_build_direct (const char *,
Expand Down
4 changes: 2 additions & 2 deletions cobc/typeck.c
Original file line number Diff line number Diff line change
Expand Up @@ -6433,7 +6433,7 @@ decimal_expand (cb_tree d, cb_tree x)

if (CB_TREE_TAG (p->y) == CB_TAG_LITERAL
&& CB_TREE_CATEGORY (p->y) == CB_CATEGORY_NUMERIC) {
t = cb_build_decimal_literal (cb_lookup_literal(p->y,1));
t = cb_build_decimal_literal (cb_lookup_literal(current_program, p->y,1));
decimal_compute (p->op, d, t);
} else {
t = decimal_alloc ();
Expand Down Expand Up @@ -7062,7 +7062,7 @@ cb_build_cond_fields (struct cb_binary_op *p,
memset (data, ' ', size1 - size2);
}
new_lit = cb_build_alphanumeric_literal (data, size1);
lit = cb_lookup_literal (new_lit, 0);
lit = cb_lookup_literal (current_progr, new_lit, 0);
return CB_BUILD_FUNCALL_3 ("memcmp",
CB_BUILD_CAST_ADDRESS (left),
CB_BUILD_CAST_ADDRESS (lit),
Expand Down
Loading