From 412c46a6652963b50de1e866b8102bc32ba06825 Mon Sep 17 00:00:00 2001 From: sf-mensch Date: Tue, 23 May 2023 22:37:15 +0000 Subject: [PATCH] follow-up to CONTROL check-in and minor general adjustments cobc: * parser.y (display_erase, display_pos_specifier): pass display attributes to codegen * parser.y (control_source): allow both an alphanumeric identifier or literal for use with CONTROL phrase * cobc.c (set_category, set_category_from_usage): changed argument types from int to their matching enum * tree.c (cb_build_prototype), parser.y (setup_prototype), tree.h (struct cb_prototype): use matching enum * parser.y: adjust a bunch of terminals to match the internal name with leading underscore as optional libcob: * common.h: added COB_SCREEN_GRAPHICS attribute * screenio.c (control_attrs): added currently not active attributes CONVERT and GRAPHICS --- cobc/ChangeLog | 16 +++++++ cobc/cobc.c | 9 ++-- cobc/parser.y | 114 ++++++++++++++++++++++++++-------------------- cobc/tree.c | 25 ++++++---- cobc/tree.h | 4 +- libcob/ChangeLog | 6 +++ libcob/common.h | 2 +- libcob/screenio.c | 4 ++ 8 files changed, 116 insertions(+), 64 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index f7d6d2065..825ed477b 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,18 @@ +2023-05-23 Simon Sobisch + + * parser.y (control_source): allow both an alphanumeric identifier or + literal for use with CONTROL phrase + * parser.y: adjust a bunch of terminals to match the internal name with + leading underscore as optional + +2023-05-15 Simon Sobisch + + * cobc.c (set_category, set_category_from_usage): changed argument types + from int to their matching enum + * tree.c (cb_build_prototype), parser.y (setup_prototype), + tree.h (struct cb_prototype): use matching enum + 2023-05-11 Simon Sobisch * cobc.c (cobc_check_valid_name): allow leading underscore, @@ -254,6 +268,8 @@ * parser.y (usage_clause_screen_report), typeck.c (validate_usage): have REPORT and SCREEN section only expecting the possibly USAGEs instead all removing the need to check for bad USAGE later + * parser.y (display_erase, display_pos_specifier): pass display attributes + to codegen 2023-01-28 Simon Sobisch diff --git a/cobc/cobc.c b/cobc/cobc.c index 7e40f985b..2ed489c48 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -4373,7 +4373,7 @@ process_filename (const char *filename) #endif } - cob_incr_temp_iteration(); + cob_incr_temp_iteration (); return fn; } @@ -5425,7 +5425,7 @@ set_picture (struct cb_field *field, char *picture, size_t picture_len) } static void -set_category_from_usage (int usage, char *type) +set_category_from_usage (const enum cb_usage usage, char *type) { switch (usage) { case CB_USAGE_INDEX: @@ -5451,7 +5451,8 @@ set_category_from_usage (int usage, char *type) } static void -set_category (int category, int usage, char *type) +set_category (const enum cb_category category, const enum cb_usage usage, + char *type) { switch (category) { case CB_CATEGORY_UNKNOWN: @@ -5556,8 +5557,10 @@ print_fields (struct cb_field *top, int *found) if (top->children) { strcpy (type, "GROUP"); if (!top->external_definition) { + /* group never has a PICTURE ... */ got_picture = 0; } else { + /* ...stilll output definitions for TYPEDEF / SAME AS */ got_picture = set_picture (top, picture, picture_len); } } else { diff --git a/cobc/parser.y b/cobc/parser.y index d4bfd0eba..1c7383995 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -1567,7 +1567,7 @@ check_for_duplicate_prototype (const cb_tree prototype_name, static void setup_prototype (cb_tree prototype_name, cb_tree ext_name, - const int type, const int is_current_element) + const enum cob_module_type type, const int is_current_element) { cb_tree prototype; int name_redefinition_allowed; @@ -2265,15 +2265,13 @@ error_if_different_display_type (struct cb_list *l, cb_tree local_upon_value, static void error_if_not_usage_display_or_nonnumeric_lit (cb_tree x) { - const int is_numeric_literal = CB_NUMERIC_LITERAL_P (x); - const int is_field_with_usage_not_display = - CB_REFERENCE_P (x) && CB_FIELD (cb_ref (x)) - && CB_FIELD (cb_ref (x))->usage != CB_USAGE_DISPLAY; - - if (is_numeric_literal) { + if (CB_NUMERIC_LITERAL_P (x)) { cb_error_x (x, _("%s is not an alphanumeric literal"), CB_LITERAL (x)->data); - } else if (is_field_with_usage_not_display) { - cb_error_x (x, _("'%s' is not USAGE DISPLAY"), cb_name (x)); + } else if (CB_REFERENCE_P (x) && CB_FIELD_P (cb_ref (x))) { + const struct cb_field *f = CB_FIELD (cb_ref (x)); + if (f->usage != CB_USAGE_DISPLAY) { + cb_error_x (x, _ ("'%s' is not USAGE DISPLAY"), cb_name (x)); + } } } @@ -5333,8 +5331,8 @@ file_control_entry: ; _select_clauses_or_error: - _select_clause_sequence _dot_or_else_end_of_file_control -| error _dot_or_else_end_of_file_control + _select_clause_sequence dot_or_else_end_of_file_control +| error dot_or_else_end_of_file_control { yyerrok; } @@ -6180,8 +6178,8 @@ i_o_control_header: ; _i_o_control_entries: -| i_o_control_list _dot_or_else_end_of_file_control -| i_o_control_list error _dot_or_else_end_of_file_control +| i_o_control_list dot_or_else_end_of_file_control +| i_o_control_list error dot_or_else_end_of_file_control { yyerrok; } @@ -6441,8 +6439,8 @@ file_description_entry: } } } - _file_description_clause_sequence _dot_or_else_end_of_file_description -| file_type error _dot_or_else_end_of_file_description + _file_description_clause_sequence dot_or_else_end_of_file_description +| file_type error dot_or_else_end_of_file_description { yyerrok; } @@ -6870,7 +6868,7 @@ communication_description_entry: check_duplicate = 0; } _communication_description_clause_sequence - _dot_or_else_end_of_communication_description + dot_or_else_end_of_communication_description ; _communication_description_clause_sequence: @@ -6962,7 +6960,7 @@ unnamed_i_o_cd_clauses: working_storage: WORKING_STORAGE { check_area_a_of ("WORKING-STORAGE SECTION"); }; _working_storage_section: | working_storage SECTION - _dot_or_else_end_of_record_description + dot_or_else_end_of_record_description { check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); header_check |= COBC_HD_WORKING_STORAGE_SECTION; @@ -6995,8 +6993,8 @@ _record_description_list: ; record_description_list: - data_description _dot_or_else_end_of_record_description -| record_description_list data_description _dot_or_else_end_of_record_description + data_description dot_or_else_end_of_record_description +| record_description_list data_description dot_or_else_end_of_record_description ; data_description: @@ -8443,7 +8441,7 @@ occurs_key_field: for (l = $4; l; l = CB_CHAIN (l)) { CB_PURPOSE (l) = $1; ref = CB_VALUE (l); - if (CB_VALID_TREE(ref)) { + if (CB_VALID_TREE (ref)) { CB_REFERENCE (ref)->chain = rchain; } } @@ -9045,7 +9043,7 @@ report_description: check_duplicate = 0; } _report_description_options - _dot_or_else_end_of_report_description + dot_or_else_end_of_report_description _report_group_description_list { $$ = get_finalized_description_tree (); @@ -9061,7 +9059,7 @@ report_description: _report_description_options: | _report_description_options report_description_option -| error _dot_or_else_end_of_report_description +| error dot_or_else_end_of_report_description { yyerrok; } @@ -9310,11 +9308,11 @@ report_group_description_entry: description_field = current_field; } } - _report_group_options _dot_or_else_end_of_report_group_description + _report_group_options dot_or_else_end_of_report_group_description { build_sum_counter (current_report, current_field); } -| level_number error _dot_or_else_end_of_report_group_description +| level_number error dot_or_else_end_of_report_group_description { yyerrok; check_pic_duplicate = 0; @@ -10039,7 +10037,7 @@ screen_option: current_field->screen_color = $3; CB_PENDING ("COLOR clause (SCREEN)"); /* no place in cob_screen */ } -| CONTROL _is display_identifier +| CONTROL _is control_source { check_repeated ("CONTROL", SYN_CLAUSE_24, &check_duplicate); current_field->screen_control = $3; @@ -11951,7 +11949,7 @@ accp_attr: check_repeated ("COLOR", SYN_CLAUSE_30, &check_duplicate); set_attribs (0, NULL, NULL, NULL, NULL, NULL, NULL, NULL, $3, NULL); } -| CONTROL _is display_identifier +| CONTROL _is control_source { check_repeated ("CONTROL", SYN_CLAUSE_31, &check_duplicate); set_attribs (0, NULL, NULL, NULL, NULL, NULL, NULL, $3, NULL, NULL); @@ -13263,7 +13261,8 @@ display_erase: } _with_display_attr { - cb_emit_display (CB_LIST_INIT (cb_space), cb_null, cb_int1, line_column, NULL, 1, FIELD_ON_SCREEN_DISPLAY); + cb_emit_display (CB_LIST_INIT (cb_space), cb_null, cb_int1, line_column, + current_statement->attr_ptr, 1, FIELD_ON_SCREEN_DISPLAY); } ; @@ -13272,7 +13271,8 @@ display_pos_specifier: would allow combination of multiple formats ...*/ field_or_literal_or_erase_with_pos_specifier _with_display_attr { - cb_emit_display ($1, cb_null, cb_int1, line_column, NULL, 1, FIELD_ON_SCREEN_DISPLAY); + cb_emit_display ($1, cb_null, cb_int1, line_column, + current_statement->attr_ptr, 1, FIELD_ON_SCREEN_DISPLAY); } ; @@ -13584,7 +13584,7 @@ disp_attr: check_repeated ("COLOR", SYN_CLAUSE_21, &check_duplicate); set_attribs (0, NULL, NULL, NULL, NULL, NULL, NULL, NULL, $3, NULL); } -| CONTROL _is display_identifier +| CONTROL _is control_source { check_repeated ("CONTROL", SYN_CLAUSE_22, &check_duplicate); set_attribs (0, NULL, NULL, NULL, NULL, NULL, NULL, $3, NULL, NULL); @@ -13689,6 +13689,11 @@ disp_attr: } ; +control_source: + display_identifier { $$ = $1; } +| alphanumeric_literal { $$ = $1; } +; + _end_display: /* empty */ %prec SHIFT_PREFER { @@ -18941,6 +18946,18 @@ arith_nonzero_x: } ; +alphanumeric_literal: + LITERAL + { + if (CB_TREE_CATEGORY ($1) != CB_CATEGORY_ALPHANUMERIC) { + cb_error_x ($1, _("an alphanumeric literal is expected here")); + $$ = cb_error_node; + } else { + $$ = $1; + } + } +; + numeric_literal: LITERAL { @@ -20047,9 +20064,9 @@ _dot: } ; -_dot_or_else_end_of_file_control: +dot_or_else_end_of_file_control: TOK_DOT -| _file_control_end_delimiter +| file_control_end_delimiter { if (! cb_verify (cb_missing_period, _("optional period"))) { YYERROR; @@ -20067,10 +20084,10 @@ level_number_in_area_a: } ; -_dot_or_else_end_of_file_description: +dot_or_else_end_of_file_description: TOK_DOT -| level_number_in_area_a -| _file_description_end_delimiter +| level_number_in_area_a /* repeats last token */ +| file_description_end_delimiter { if (! cb_verify (cb_missing_period, _("optional period"))) { YYERROR; @@ -20079,19 +20096,19 @@ _dot_or_else_end_of_file_description: } ; -_dot_or_else_end_of_communication_description: -_dot_or_else_end_of_record_description; +dot_or_else_end_of_communication_description: +dot_or_else_end_of_record_description; -_dot_or_else_end_of_report_description: -_dot_or_else_end_of_record_description; +dot_or_else_end_of_report_description: +dot_or_else_end_of_record_description; -_dot_or_else_end_of_report_group_description: -_dot_or_else_end_of_record_description; +dot_or_else_end_of_report_group_description: +dot_or_else_end_of_record_description; -_dot_or_else_end_of_record_description: +dot_or_else_end_of_record_description: TOK_DOT -| level_number_in_area_a -| _record_description_end_delimiter +| level_number_in_area_a /* repeats last token */ +| record_description_end_delimiter { if (! cb_verify (cb_missing_period, _("optional period"))) { YYERROR; @@ -20100,15 +20117,14 @@ _dot_or_else_end_of_record_description: } ; -_file_control_end_delimiter: +file_control_end_delimiter: SELECT | I_O_CONTROL | DATA | PROCEDURE; -_file_description_end_delimiter: - LEVEL_NUMBER | TOK_FILE | PROCEDURE; +file_description_end_delimiter: + TOK_FILE | PROCEDURE; -_record_description_end_delimiter: - LEVEL_NUMBER | PROCEDURE | COMMUNICATION | LOCAL_STORAGE -| LINKAGE | REPORT | SCREEN; +record_description_end_delimiter: + PROCEDURE | COMMUNICATION | LOCAL_STORAGE | LINKAGE | REPORT | SCREEN; _dot_or_else_area_a: /* in PROCEDURE DIVISION */ TOK_DOT diff --git a/cobc/tree.c b/cobc/tree.c index f2f8156db..709ed9a9a 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -1388,8 +1388,8 @@ cb_tree_category (cb_tree x) struct cb_reference *r; struct cb_field *f; - if (x == cb_error_node) { - return (enum cb_category)0; + if (CB_INVALID_TREE (x)) { + return CB_CATEGORY_UNKNOWN; } /* LCOV_EXCL_START */ @@ -4140,6 +4140,7 @@ cb_field_size (const cb_tree x) /* LCOV_EXCL_STOP */ } +/* returns the record field (level 01) of 'f' */ struct cb_field * cb_field_founder (const struct cb_field * const f) { @@ -4152,6 +4153,10 @@ cb_field_founder (const struct cb_field * const f) return (struct cb_field *)ff; } +/* returns the first field that has an ODO below 'f', if any + note: per standard there would be only 0 or 1 of those, but mind + the supported extensions that allow nested ODO as well as + the fact that 'f' may have an ODO on its own */ struct cb_field * cb_field_variable_size (const struct cb_field *f) { @@ -4430,7 +4435,7 @@ finalize_report (struct cb_report *r, struct cb_field *records) } } - /* Insure report record size is set large enough */ + /* ensure report record size is set large enough */ for (k=0; k < 2; k++) { for (p = records; p; p = p->sister) { if (p->storage != CB_STORAGE_REPORT) @@ -4441,14 +4446,16 @@ finalize_report (struct cb_report *r, struct cb_field *records) } if (k == 1 && p->level == 1) { - if (p->size < r->rcsz) + if (p->size < r->rcsz) { p->size = r->rcsz; - if (p->memory_size < r->rcsz) + } + if (p->memory_size < r->rcsz) { p->memory_size = r->rcsz; + } } } if (p->report_column > 0) { - if(p->report_column - 1 + p->size > r->rcsz) { + if (p->report_column - 1 + p->size > r->rcsz) { r->rcsz = p->report_column - 1 + p->size; } } @@ -6855,7 +6862,7 @@ warn_if_no_definition_seen_for_prototype (const struct cb_prototype *proto) cb_tree cb_build_prototype (const cb_tree prototype_name, const cb_tree ext_name, - const int type) + const enum cob_module_type type) { struct cb_prototype *prototype; @@ -6912,13 +6919,13 @@ get_category_from_arguments (const struct cb_intrinsic_table *cbp, cb_tree args, cb_tree arg; int argnum = 0; - for (l = args; l; l = CB_CHAIN(l)) { + for (l = args; l; l = CB_CHAIN (l)) { argnum++; if (argnum < check_from) continue; if (check_to && argnum > check_to) break; - arg = CB_VALUE(l); + arg = CB_VALUE (l); arg_cat = cb_tree_category (arg); if (arg_cat == CB_CATEGORY_NATIONAL_EDITED) { diff --git a/cobc/tree.h b/cobc/tree.h index f1f9d48a6..0652a659e 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1925,7 +1925,7 @@ struct cb_prototype { const char *name; /* External name of the prototype/definition */ const char *ext_name; - int type; + enum cob_module_type type; }; #define CB_PROTOTYPE(x) (CB_TREE_CAST (CB_TAG_PROTOTYPE, struct cb_prototype, x)) @@ -2154,7 +2154,7 @@ extern cb_tree cb_build_assign (const cb_tree, const cb_tree); extern cb_tree cb_build_intrinsic (cb_tree, cb_tree, cb_tree, const int); extern cb_tree cb_build_prototype (const cb_tree, - const cb_tree, const int); + const cb_tree, const enum cob_module_type); extern cb_tree cb_build_any_intrinsic (cb_tree); extern cb_tree cb_build_search (const int, diff --git a/libcob/ChangeLog b/libcob/ChangeLog index e6153eb4e..7bdd69274 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -1,4 +1,10 @@ +2023-05-23 Simon Sobisch + + * common.h: added COB_SCREEN_GRAPHICS attribute + * screenio.c (control_attrs): added currently not active attributes + CONVERT and GRAPHICS + 2023-05-15 Simon Sobisch * screenio.c: integrated changes of Chuck Haatveet for CONTROL handling diff --git a/libcob/common.h b/libcob/common.h index 5ebcb0c01..1f0d9cac3 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1008,7 +1008,7 @@ typedef cob_s64_t cob_flags_t; #define COB_SCREEN_UPPER ((cob_flags_t)1 << 28) #define COB_SCREEN_LOWER ((cob_flags_t)1 << 29) #define COB_SCREEN_CONV ((cob_flags_t)1 << 30) -/*#define COB_SCREEN_reserved ((cob_flags_t)1 << 31) /+ reserved for next flag used in screenio */ +#define COB_SCREEN_GRAPHICS ((cob_flags_t)1 << 31) #define COB_SCREEN_TAB ((cob_flags_t)1 << 32) /* used for syntax checking */ #define COB_SCREEN_NO_UPDATE ((cob_flags_t)1 << 33) /* used for syntax checking */ #define COB_SCREEN_SCROLL_UP ((cob_flags_t)1 << 34) /* used for syntax checking */ diff --git a/libcob/screenio.c b/libcob/screenio.c index be18a9fbe..b8b671578 100644 --- a/libcob/screenio.c +++ b/libcob/screenio.c @@ -663,6 +663,7 @@ static struct parse_control control_attrs[] = { { "BLANK LINE" , COB_SCREEN_BLANK_LINE } , { "BLANK SCREEN" , COB_SCREEN_BLANK_SCREEN } , { "BLINK" , COB_SCREEN_BLINK } , + { "CONVERT" , COB_SCREEN_CONV } , { "ECHO" , COB_SCREEN_NO_ECHO } , { "EMPTY-CHECK" , -1 } , { "ERASE EOL" , COB_SCREEN_ERASE_EOL } , @@ -671,6 +672,7 @@ static struct parse_control control_attrs[] = { { "FOREGROUND-COLOR" , 0 } , { "FOREGROUND-COLOUR" , 0 } , { "FULL" , COB_SCREEN_FULL } , + { "GRAPHICS" , COB_SCREEN_GRAPHICS } , { "GRID" , COB_SCREEN_GRID } , { "HIGH" , COB_SCREEN_HIGHLIGHT } , { "HIGHLIGHT" , COB_SCREEN_HIGHLIGHT } , @@ -1576,6 +1578,7 @@ cob_screen_puts (cob_screen *s, cob_field *f, const cob_u32_t is_input, #if 0 /* RXWRXW - Attr */ cob_screen_attr (s->foreg, s->backg, s->attr, NULL, NULL, stmt); #endif + /* TODO: replace character by special "char" if s->attr & GRPAHICS */ if (s->attr & COB_SCREEN_INPUT) { cob_screen_attr (s->foreg, s->backg, s->attr, NULL, NULL, stmt); if (s->prompt) { @@ -3127,6 +3130,7 @@ field_display (cob_field *f, cob_flags_t fattr, const int line, const int column cob_addnstr ((char *)f->data, size_display % fsize); } } else { + /* TODO: replace character by special "char" if f->attr & GRPAHICS */ cob_addnstr ((char *)f->data, cob_min_int (size_display, fsize)); if (size_display > fsize) { /* WITH SIZE larger than field displays trailing spaces */