From 1ee5dc5b6db78ee517f5f2e08c097c95aaa4735f Mon Sep 17 00:00:00 2001 From: David Declerck Date: Mon, 23 Sep 2024 20:38:36 +0200 Subject: [PATCH] Merge SVN 4883 --- cobc/ChangeLog | 11 +++++++++- cobc/codegen.c | 55 +++++++++++++++++++++++++++++++++----------------- cobc/tree.h | 43 ++++++++++++++++++++++----------------- cobc/typeck.c | 10 +++++++-- 4 files changed, 78 insertions(+), 41 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index deda5440f..df61772df 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -255,6 +255,16 @@ and the related BYTE-LENGTH clause * field.c, tree.c, typeck.c: minimal adjustments for PIC U +2022-12-16 Simon Sobisch + + * tree.h (cb_binary_op, cb_binary_op_flag, cb_binary_op_op): changed struct + cb_binary_op to use new enums for the operation and for "special flags" + * tree.h (BOP_OPERANDS_SWAPPED), codegen.c (output_cond), typeck.c + (cb_build_cond, swap_condition_operands): store flag when swap operation + is done and swap the result for return values as used in SEARCH ALL later + * codegen.c (output_long_integer): reduce scope of variables as done + in (output_integer) + 2022-12-15 Simon Sobisch * codegen.c (output_initialize_to_value): fix bad generation for VALUE size @@ -283,7 +293,6 @@ * typeck.c (cb_build_cond_fields): optimize comparison between field and SPACES up to COB_SPACES_ALPHABETIC_BYTE_LENGTH - 2022-12-14 Simon Sobisch * typeck.c (validate_move): fix bug #643 add check for SET literal TO val diff --git a/cobc/codegen.c b/cobc/codegen.c index ea73b0935..19c93c147 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -3378,7 +3378,7 @@ output_integer (cb_tree x) break; case CB_TAG_BINARY_OP: { const struct cb_binary_op *p = CB_BINARY_OP (x); - if (p->flag) { + if (p->flag == BOP_RESOLVE_AS_INTEGER) { if (!cb_fits_int (p->x) || !cb_fits_int (p->y)) { output ("cob_get_int ("); output_param (x, -1); @@ -3685,10 +3685,6 @@ output_integer (cb_tree x) static void output_long_integer (cb_tree x) { - struct cb_binary_op *p; - struct cb_cast *cp; - struct cb_field *f; - switch (CB_TREE_TAG (x)) { case CB_TAG_CONST: if (x == cb_zero) { @@ -3714,9 +3710,9 @@ output_long_integer (cb_tree x) case CB_TAG_LITERAL: output (CB_FMT_LLD_F, cb_get_long_long (x)); break; - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - if (p->flag) { + case CB_TAG_BINARY_OP: { + const struct cb_binary_op *p = CB_BINARY_OP (x); + if (p->flag == BOP_RESOLVE_AS_INTEGER) { if (!cb_fits_long_long (p->x) || !cb_fits_long_long (p->y)) { output ("cob_get_llint ("); @@ -3740,8 +3736,9 @@ output_long_integer (cb_tree x) output (")"); } break; - case CB_TAG_CAST: - cp = CB_CAST (x); + } + case CB_TAG_CAST: { + const struct cb_cast *cp = CB_CAST (x); switch (cp->cast_type) { case CB_CAST_ADDRESS: output ("("); @@ -3766,8 +3763,9 @@ output_long_integer (cb_tree x) /* LCOV_EXCL_STOP */ } break; - case CB_TAG_REFERENCE: - f = cb_code_field (x); + } + case CB_TAG_REFERENCE: { + struct cb_field *f = cb_code_field (x); switch (f->usage) { case CB_USAGE_INDEX: if (f->index_type != CB_NORMAL_INDEX) { @@ -3913,6 +3911,7 @@ output_long_integer (cb_tree x) output_func_1 ("cob_get_llint", x); break; + } case CB_TAG_INTRINSIC: output ("cob_get_llint ("); output_param (x, -1); @@ -4876,12 +4875,13 @@ output_func_1 (const char *name, cb_tree x) /* Condition */ +/* output condition 'x' with optional storage in + C field "ret" depending on 'save_flag' */ static void output_cond (cb_tree x, const int save_flag) { - struct cb_binary_op *p; - in_cond = 1; + switch (CB_TREE_TAG (x)) { case CB_TAG_CONST: if (x == cb_true) { @@ -4895,8 +4895,8 @@ output_cond (cb_tree x, const int save_flag) } /* LCOV_EXCL_STOP */ break; - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); + case CB_TAG_BINARY_OP: { + const struct cb_binary_op *p = CB_BINARY_OP (x); switch (p->op) { case '!': output ("!"); @@ -4922,7 +4922,12 @@ output_cond (cb_tree x, const int save_flag) case ']': case '~': output ("((int)"); - output_cond (p->x, save_flag); + if (save_flag + && p->flag == BOP_OPERANDS_SWAPPED) { + output_cond (p->x, 2); + } else { + output_cond (p->x, save_flag); + } switch (p->op) { case '=': output (" == 0"); @@ -4954,9 +4959,15 @@ output_cond (cb_tree x, const int save_flag) break; } break; + } case CB_TAG_FUNCALL: if (save_flag) { - output ("(ret = "); + /* handle original swapped function */ + if (save_flag == 2) { + output ("(ret = -"); + } else { + output ("(ret = "); + } } output_funcall (x); if (save_flag) { @@ -4965,7 +4976,12 @@ output_cond (cb_tree x, const int save_flag) break; case CB_TAG_LIST: if (save_flag) { - output ("(ret = "); + /* handle original swapped function */ + if (save_flag == 2) { + output ("(ret = -"); + } else { + output ("(ret = "); + } } inside_stack[inside_check++] = 0; /* LCOV_EXCL_START */ @@ -4993,6 +5009,7 @@ output_cond (cb_tree x, const int save_flag) CB_TREE_TAG_UNEXPECTED_ABORT (x); /* LCOV_EXCL_STOP */ } + in_cond = 0; } diff --git a/cobc/tree.h b/cobc/tree.h index 8d7276018..6b5069e46 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1264,30 +1264,35 @@ struct cb_reference { /* Binary operation */ -/* - '+' x + y - '-' x - y - '*' x * y - '/' x / y - '^' x ** y - '=' x = y - '>' x > y - '<' x < y - '[' x <= y - ']' x >= y - '~' x != y - '!' not x - '&' x and y - '|' x or y - '@' ( x ) -*/ +enum cb_binary_op_op { + BOP_PLUS = '+', /* x + y */ + BOP_MINUS = '-', /* x - y */ + BOP_MULT = '*', /* x * y */ + BOP_DIV = '/', /* x / y */ + BOP_POW = '^', /* x ** y */ + BOP_EQ = '=', /* x = y */ + BOP_GT = '>', /* x > y */ + BOP_LT = '<', /* x < y */ + BOP_LE = '[', /* x <= y */ + BOP_GE = ']', /* x >= y */ + BOP_NE = '~', /* x != y */ + BOP_NOT = '!', /* not x */ + BOP_AND = '&', /* x and y */ + BOP_OR = '|', /* x or y */ + BOP_PARENS = '@' /* ( x ) */ +}; + +enum cb_binary_op_flag { + BOP_RESOLVE_AS_INTEGER = 1, + BOP_OPERANDS_SWAPPED = 2 +}; struct cb_binary_op { struct cb_tree_common common; /* Common values */ cb_tree x; /* LHS */ cb_tree y; /* RHS */ - int op; /* Operation */ - unsigned int flag; /* Special usage */ + enum cb_binary_op_op op; /* Operation */ + enum cb_binary_op_flag flag; /* Special usage */ }; #define CB_BINARY_OP(x) (CB_TREE_CAST (CB_TAG_BINARY_OP, struct cb_binary_op, x)) diff --git a/cobc/typeck.c b/cobc/typeck.c index da173b3a2..51d23c30c 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -2603,9 +2603,10 @@ cb_build_identifier (cb_tree x, const int subchk) } for (l = r->subs; l; l = CB_CHAIN (l)) { - if (CB_BINARY_OP_P (CB_VALUE (l))) { + cb_tree val = CB_VALUE (l); + if (CB_BINARY_OP_P (val)) { /* Set special flag for codegen */ - CB_BINARY_OP(CB_VALUE(l))->flag = 1; + CB_BINARY_OP (val)->flag = BOP_RESOLVE_AS_INTEGER; } } @@ -7341,6 +7342,8 @@ swap_condition_operands (struct cb_binary_op *p) { cb_tree y = p->x; + p->flag = BOP_OPERANDS_SWAPPED; + p->x = p->y; p->y = y; @@ -7439,6 +7442,9 @@ cb_build_cond (cb_tree x) break; } ret = cb_build_binary_op (ret, p->op, p->y); + if (CB_VALID_TREE (ret)) { + CB_BINARY_OP (ret)->flag = p->flag; + } } if (ret != cb_true && ret != cb_false) { cb_copy_source_reference (ret, x);