diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 0c5659e71..7aa841faa 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,23 @@ +2023-10-17 David Declerck + + 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 * typeck.c (search_set_keys): improving SEARCH ALL syntax checks diff --git a/cobc/codegen.c b/cobc/codegen.c index f32391606..47a582b1b 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -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; @@ -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 (); @@ -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) { struct cb_literal *literal; struct literal_list *l; @@ -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; } @@ -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++; } @@ -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: @@ -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 (); @@ -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 (); @@ -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"); diff --git a/cobc/tree.h b/cobc/tree.h index 5fb72a3fb..42e87dc1f 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -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; @@ -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 */ @@ -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 *, diff --git a/cobc/typeck.c b/cobc/typeck.c index ddc3f567a..c4f39cc9f 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -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 (); @@ -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),