From 9b8f7de81c0ead7b5285e879fb87a0f89b37106a Mon Sep 17 00:00:00 2001 From: David Declerck Date: Mon, 18 Nov 2024 17:13:29 +0100 Subject: [PATCH] Merge SVN 5037 --- cobc/ChangeLog | 12 ++++++++++++ cobc/cobc.c | 5 +++-- cobc/codegen.c | 45 ++++++++++++++++++++++++--------------------- cobc/tree.c | 6 +++++- cobc/tree.h | 50 +++++++++++++++++++++++++++++++++++--------------- 5 files changed, 79 insertions(+), 39 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index e2c40b9a..8de78cd9 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -50,6 +50,18 @@ * typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options * help.c (cobc_print_usage_dialect): extended -fregister help +2023-05-09 Simon Sobisch + + * codegen.c (output_funcall): backup and restore adjusted static fields, + minor refactoring + * codegen.c (output_funcall_item): extracted from (output_funcall) + +2023-05-08 Simon Sobisch + + * tree.c (cb_build_funcall), tree.h (struct cb_funcall): defined + max. parameters for internal function calls as CB_BUILD_FUNCALL_MAX + and increased it to 14 + 2023-05-05 Simon Sobisch * field.c (cb_resolve_redefines): fix #881 wrong REDEFINES error on diff --git a/cobc/cobc.c b/cobc/cobc.c index b0ac35d9..8491cfcf 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -2119,14 +2119,15 @@ set_compile_date (void) { static int sde_todo = 0; if (sde_todo == 0) { - char *s = getenv ("SOURCE_DATE_EPOCH"); + unsigned char *s = (unsigned char *) getenv ("SOURCE_DATE_EPOCH"); sde_todo = 1; if (s && *s) { if (cob_set_date_from_epoch (¤t_compile_time, s) == 0) { set_compile_date_tm (); return; } - cobc_err_msg (_("environment variable '%s' has invalid content"), "SOURCE_DATE_EPOCH"); + cobc_err_msg (_("environment variable '%s' has invalid content"), + "SOURCE_DATE_EPOCH"); if (!cb_flag_syntax_only) { cb_source_file = NULL; cobc_abort_terminate (0); diff --git a/cobc/codegen.c b/cobc/codegen.c index f1e88c2c..55eb950e 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -4847,12 +4847,26 @@ output_funcall_typed (struct cb_funcall *p, const char type) } +static void COB_INLINE COB_A_INLINE +output_funcall_item (cb_tree x, const int i, unsigned int func_nolitcast) +{ + if (x && CB_LITERAL_P (x)) { + nolitcast = func_nolitcast; + } else { + nolitcast = 0; + } + output_param (x, i); +} + + static void output_funcall (cb_tree x) { struct cb_funcall *p; cb_tree l; int i; + const int nolitcast_origin = nolitcast; + const int screenptr_origin = screenptr; p = CB_FUNCALL (x); if (p->name[0] == '$') { @@ -4863,33 +4877,22 @@ output_funcall (cb_tree x) screenptr = p->screenptr; output ("%s (", p->name); for (i = 0; i < p->argc; i++) { + if (i) { + output (", "); + } if (p->varcnt && i + 1 == p->argc) { - output ("%d, ", p->varcnt); - for (l = p->argv[i]; l; l = CB_CHAIN (l)) { - if (CB_VALUE (l) && CB_LITERAL_P (CB_VALUE (l))) { - nolitcast = p->nolitcast; - } - output_param (CB_VALUE (l), i); - nolitcast = 0; - i++; - if (CB_CHAIN (l)) { - output (", "); - } - } - } else { - if (p->argv[i] && CB_LITERAL_P (p->argv[i])) { - nolitcast = p->nolitcast; - } - output_param (p->argv[i], i); - nolitcast = 0; - if (i + 1 < p->argc) { + output ("%d", p->varcnt); + for (l = p->argv[i]; l; l = CB_CHAIN (l), i++) { output (", "); + output_funcall_item (CB_VALUE (l), i, p->nolitcast); } + } else { + output_funcall_item (p->argv[i], i, p->nolitcast); } } output (")"); - nolitcast = 0; - screenptr = 0; + nolitcast = nolitcast_origin; + screenptr = screenptr_origin; } static void diff --git a/cobc/tree.c b/cobc/tree.c index 56373983..a8be9d9b 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -6832,7 +6832,8 @@ cb_build_funcall (const char *name, const int argc, const cb_tree a1, const cb_tree a2, const cb_tree a3, const cb_tree a4, const cb_tree a5, const cb_tree a6, const cb_tree a7, const cb_tree a8, const cb_tree a9, - const cb_tree a10, const cb_tree a11) + const cb_tree a10, const cb_tree a11, const cb_tree a12, + const cb_tree a13, const cb_tree a14) { struct cb_funcall *p; @@ -6853,6 +6854,9 @@ cb_build_funcall (const char *name, const int argc, p->argv[8] = a9; p->argv[9] = a10; p->argv[10] = a11; + p->argv[11] = a12; + p->argv[12] = a13; + p->argv[13] = a14; return CB_TREE (p); } diff --git a/cobc/tree.h b/cobc/tree.h index 5be562d4..17cc5c8e 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -895,6 +895,8 @@ struct cb_field { cb_tree screen_foreg; /* FOREGROUND */ cb_tree screen_backg; /* BACKGROUND */ cb_tree screen_prompt; /* PROMPT */ + cb_tree screen_control; /* CONTROL identifier (variable named attributes) */ + cb_tree screen_color; /* COLOR identifier (variable bit-shifted attributes) */ cb_tree report_source; /* SOURCE field */ cb_tree report_from; /* SOURCE field subscripted; so MOVE to report_source */ cb_tree report_sum_counter;/* SUM counter */ @@ -1316,10 +1318,11 @@ struct cb_binary_op { /* Function call */ +#define CB_BUILD_FUNCALL_MAX 14 struct cb_funcall { struct cb_tree_common common; /* Common values */ const char *name; /* Function name */ - cb_tree argv[11]; /* Function arguments */ + cb_tree argv[CB_BUILD_FUNCALL_MAX]; /* Function arguments */ int argc; /* Number of arguments */ int varcnt; /* Variable argument count */ unsigned int screenptr; /* SCREEN usage */ @@ -1529,6 +1532,9 @@ struct cb_attr_struct { cb_tree timeout; /* TIMEOUT */ cb_tree prompt; /* PROMPT */ cb_tree size_is; /* [PROTECTED] SIZE [IS] */ + cb_tree control; /* CONTROL [IS] (named attributes) */ + cb_tree color; /* CONTROL (bit-shifted attributes) */ + cb_tree cursor; /* CURSOR */ cob_flags_t dispattrs; /* Attributes */ }; @@ -1861,7 +1867,8 @@ struct cb_program { when cb_correct_program_order is set */ const char *program_name; /* Internal program-name */ const char *program_id; /* Demangled external PROGRAM-ID */ - char *source_name; /* Source name */ + char *source_name; /* Source name, + only set in the first "real" program */ char *orig_program_id; /* Original external PROGRAM-ID */ struct cb_word **word_table; /* Name hash table */ struct local_filename *local_include; /* Local include info */ @@ -2197,7 +2204,8 @@ extern cb_tree cb_build_funcall (const char *, const int, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, const cb_tree, - const cb_tree); + const cb_tree, const cb_tree, + const cb_tree, const cb_tree); extern cb_tree cb_build_cast (const enum cb_cast_type, const cb_tree); @@ -2691,51 +2699,63 @@ extern int cobc_has_areacheck_directive (const char *directive); #define CB_BUILD_FUNCALL_0(f) \ cb_build_funcall (f, 0, NULL, NULL, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_1(f,a1) \ cb_build_funcall (f, 1, a1, NULL, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_2(f,a1,a2) \ cb_build_funcall (f, 2, a1, a2, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_3(f,a1,a2,a3) \ cb_build_funcall (f, 3, a1, a2, a3, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_4(f,a1,a2,a3,a4) \ cb_build_funcall (f, 4, a1, a2, a3, a4, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_5(f,a1,a2,a3,a4,a5) \ cb_build_funcall (f, 5, a1, a2, a3, a4, a5, \ - NULL, NULL, NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_6(f,a1,a2,a3,a4,a5,a6) \ cb_build_funcall (f, 6, a1, a2, a3, a4, a5, a6, \ - NULL, NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_7(f,a1,a2,a3,a4,a5,a6,a7) \ cb_build_funcall (f, 7, a1, a2, a3, a4, a5, a6, a7, \ - NULL, NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_8(f,a1,a2,a3,a4,a5,a6,a7,a8) \ cb_build_funcall (f, 8, a1, a2, a3, a4, a5, a6, a7, a8, \ - NULL, NULL, NULL) + NULL, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_9(f,a1,a2,a3,a4,a5,a6,a7,a8,a9) \ cb_build_funcall (f, 9, a1, a2, a3, a4, a5, a6, a7, a8, \ - a9, NULL, NULL) + a9, NULL, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_10(f,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) \ cb_build_funcall (f, 10, a1, a2, a3, a4, a5, a6, a7, a8, \ - a9, a10, NULL) + a9, a10, NULL, NULL, NULL, NULL) #define CB_BUILD_FUNCALL_11(f,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11) \ cb_build_funcall (f, 11, a1, a2, a3, a4, a5, a6, a7, a8, \ - a9, a10, a11) + a9, a10, a11, NULL, NULL, NULL) + +#define CB_BUILD_FUNCALL_12(f,a1,a2,a3,a4,a5,a6,a7,a8,a9,a11,a12) \ + cb_build_funcall (f, 9, a1, a2, a3, a4, a5, a6, a7, a8, \ + a9, a10, a11, a12, NULL, NULL) + +#define CB_BUILD_FUNCALL_13(f,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) \ + cb_build_funcall (f, 10, a1, a2, a3, a4, a5, a6, a7, a8, \ + a9, a10, a11, a12, a13, NULL) + +#define CB_BUILD_FUNCALL_14(f,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14) \ + cb_build_funcall (f, 11, a1, a2, a3, a4, a5, a6, a7, a8, \ + a9, a10, a11, a12, a13, a14) /* Miscellaneous defines */