From 3b0cdb27f4fe08f765d6397f3b73b1f345936a8b Mon Sep 17 00:00:00 2001 From: David Declerck Date: Wed, 19 Jun 2024 16:10:17 +0200 Subject: [PATCH] Merge SVN 4646 --- cobc/ChangeLog | 8 +-- cobc/codegen.c | 79 +++++++++++++++------------ config/ChangeLog | 1 - config/cobol85.conf | 2 +- config/default.conf | 1 + config/xopen.conf | 6 +- tests/testsuite.src/configuration.at | 2 +- tests/testsuite.src/run_initialize.at | 19 ++++--- 8 files changed, 64 insertions(+), 54 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index eb4b4f1e6..63fd96b61 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,5 +1,6 @@ 2023-06-02 Simon Sobisch + * tree.h (cb_file), parser.y: organization and access_mode as enums * typeck.c (cb_emit_sort_init, cb_emit_sort_using, cb_emit_sort_giving), parser.y: extended syntax checks, distinguish MERGE and SORT within @@ -314,12 +315,9 @@ * cobc.h,help.c,codegen.c : Add define CB_CONFIG_SINT as signed 'int' * config.c (cb_config_entry): for CB_INT check for a single character Also check for word 'ignore' and make no changes - -2022-06-10 Ron Norman - * codegen.c : Improvement of code emitted for INITIALIZE of tables - Initial table values, then clear next, - then propagate through remainder of the table + Initial table values, then clear next, + then propagate through remainder of the table 2022-05-31 Simon Sobisch diff --git a/cobc/codegen.c b/cobc/codegen.c index 4f993cf30..0f248560b 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -4326,7 +4326,11 @@ output_param (cb_tree x, int id) break; case CB_TAG_REPORT_LINE: /* NOTE: do not use CB_REFERENCE_P because 'x' has a tag of CB_TAG_REPORT_LINE */ +#if 1 /* FIXME: Should have expected type! */ r = (struct cb_reference *)x; +#else + r = CB_REFERENCE (x); +#endif f = CB_FIELD (r->value); output ("&%s%d", CB_PREFIX_REPORT_LINE, f->id); break; @@ -5249,11 +5253,12 @@ propagate_table (cb_tree x, int bgn_idx) struct cb_field *f = cb_code_field (x); const unsigned int occ = (unsigned int)f->occurs_max; cob_uli_t len = (cob_uli_t)f->size; - size_t maxlen = len * occ; + cob_uli_t maxlen = len * occ; unsigned int j = 1; - if (bgn_idx < 1) + if (bgn_idx < 1) { bgn_idx = 1; + } if (gen_init_working || (!chk_field_variable_size (f) @@ -5261,39 +5266,40 @@ propagate_table (cb_tree x, int bgn_idx) && !f->depending)) { /* Table size is known at compile time */ /* Generate inline 'memcpy' to propagate the array data */ - output_block_open (); - output_prefix (); - output ("cob_u8_ptr b_ptr = "); - output_data(x); - if (bgn_idx > 1) { - output (" + %ld",len * (bgn_idx - 1)); - maxlen -= len * (bgn_idx - 1); - } - output (";"); - output_newline (); - - /* double the chunks each time */ - do { + if (occ > 1) { + output_block_open (); output_prefix (); - output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);", len, len); - output ("\t/* %s: %6u thru %u */", - f->name, j + bgn_idx, j * 2 + bgn_idx - 1); + output ("cob_u8_ptr b_ptr = "); + output_data (x); + if (bgn_idx > 1) { + output (" + %ld",len * (bgn_idx - 1)); + maxlen -= len * (bgn_idx - 1); + } + output (";"); output_newline (); - j = j * 2; - len = len * 2; - } while ((j * 2) < occ); - /* missing piece after last chunk */ - if (j < occ - && maxlen > len) { - output_prefix (); - output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);", - len, maxlen - len); - output ("\t/* %s: %6u thru %u */", - f->name, j + bgn_idx, occ); - output_newline (); + /* double the chunks each time */ + do { + output_prefix (); + output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);", len, len); + output ("\t/* %s: %6u thru %u */", + f->name, j + bgn_idx, j * 2 + bgn_idx - 1); + output_newline (); + j = j * 2; + len = len * 2; + } while ((j * 2) < occ); + /* missing piece after last chunk */ + if (j < occ + && maxlen > len) { + output_prefix (); + output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);", + len, maxlen - len); + output ("\t/* %s: %6u thru %u */", + f->name, j + bgn_idx, occ); + output_newline (); + } + output_block_close (); } - output_block_close (); } else { /* Table size is only known at run time */ output_prefix (); @@ -5915,9 +5921,9 @@ output_initialize_occurs (struct cb_initialize *p, cb_tree x) cb_tree list; cb_tree l; int k, offset, idx, idx_clr, total_occurs, simple_occurs; - int idxtbl[COB_MAX_SUBSCRIPTS+1]; - int occtbl[COB_MAX_SUBSCRIPTS+1]; - struct cb_field *pftbl[COB_MAX_SUBSCRIPTS+1]; + int idxtbl[COB_MAX_SUBSCRIPTS+1] = { 0 }; + int occtbl[COB_MAX_SUBSCRIPTS+1] = { 0 }; + struct cb_field *pftbl[COB_MAX_SUBSCRIPTS+1] = { NULL }; f = cb_code_field (x); if (f->flag_occurs @@ -5926,10 +5932,12 @@ output_initialize_occurs (struct cb_initialize *p, cb_tree x) simple_occurs = 1; else simple_occurs = 0; +#if 0 /* CHECKME: the init above should be fine */ for (idx=0; idx <= COB_MAX_SUBSCRIPTS; idx++) { idxtbl[idx] = 0; pftbl[idx] = NULL; } +#endif total_occurs = 1; idx_clr = 0; for (idx = 0, pf = f; pf; pf = pf->parent) { @@ -6131,6 +6139,9 @@ output_initialize_compound (struct cb_initialize *p, cb_tree x) if (f->occurs_max > 1) { + /* all exceptions should have been raised above, + so temporarily detach from the reference */ + ref->check = NULL; ref->length = NULL; for (pf = f; pf && !pf->flag_occurs_values; pf = pf->parent); diff --git a/config/ChangeLog b/config/ChangeLog index 79d83d9bc..987fac78c 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -42,7 +42,6 @@ * general: add a stop-error-statement option to allow configuring the support of the STOP ERROR statement - 2022-02-07 David Declerck * general: add a record-contains-depending-clause option to allow diff --git a/config/cobol85.conf b/config/cobol85.conf index 4780c80c1..4459434b7 100644 --- a/config/cobol85.conf +++ b/config/cobol85.conf @@ -1,6 +1,6 @@ # GnuCOBOL compiler configuration # -# Copyright (C) 2001-2012, 2014-2021 Free Software Foundation, Inc. +# Copyright (C) 2001-2012, 2014-2022 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, # Ron Norman # diff --git a/config/default.conf b/config/default.conf index ce863dbbc..359890e8c 100644 --- a/config/default.conf +++ b/config/default.conf @@ -298,6 +298,7 @@ align-record: 0 align-opt: no defaultbyte: ignore record-contains-depending-clause: unconformable +defaultbyte: ignore # use complete word list; synonyms and exceptions are specified below reserved-words: default diff --git a/config/xopen.conf b/config/xopen.conf index e594e5cc1..25e0f338b 100644 --- a/config/xopen.conf +++ b/config/xopen.conf @@ -1,6 +1,6 @@ # GnuCOBOL compiler configuration # -# Copyright (C) 2001-2012, 2014-2021 Free Software Foundation, Inc. +# Copyright (C) 2001-2012, 2014-2022 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, # Ron Norman # @@ -281,11 +281,11 @@ assign-using-variable: unconformable assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: unconformable +self-call-recursive: skip +record-contains-depending-clause: obsolete align-record: 0 align-opt: no defaultbyte: ignore -self-call-recursive: skip -record-contains-depending-clause: obsolete # obsolete in COBOL85 and currently not available as dialect features: # 1: All literal with numeric or numeric edited item diff --git a/tests/testsuite.src/configuration.at b/tests/testsuite.src/configuration.at index 6ba40cb6f..3bf827dda 100644 --- a/tests/testsuite.src/configuration.at +++ b/tests/testsuite.src/configuration.at @@ -1,4 +1,4 @@ -## Copyright (C) 2014-2021 Free Software Foundation, Inc. +## Copyright (C) 2014-2022 Free Software Foundation, Inc. ## Written by Simon Sobisch ## ## This file is part of GnuCOBOL. diff --git a/tests/testsuite.src/run_initialize.at b/tests/testsuite.src/run_initialize.at index f64c8a8cf..b034a233a 100644 --- a/tests/testsuite.src/run_initialize.at +++ b/tests/testsuite.src/run_initialize.at @@ -253,7 +253,7 @@ AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. - *01 FAILED PIC 9(4) COMP-5 VALUE ZERO. + 01 FAILED PIC 9(4) COMP-5 VALUE ZERO. 01 G. 02 G2 OCCURS 3. 03 X PIC 9 VALUE ZERO. @@ -267,30 +267,31 @@ AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. DISPLAY "Compile failed: " G "." DISPLAY " should be: " "09Y9Y9Y9Y9YZ09Y9Y9Y9Y9YZ09Y9Y9Y9Y9YZ." - * ADD 1 TO FAILED + ADD 1 TO FAILED END-IF. INITIALIZE G. IF G NOT = "00 0 0 0 0 00 0 0 0 0 00 0 0 0 0 " DISPLAY "INITIALIZE failed: " G "." DISPLAY " should be: " "00 0 0 0 0 00 0 0 0 0 00 0 0 0 0 ." - * ADD 1 TO FAILED + ADD 1 TO FAILED END-IF. INITIALIZE G ALL TO VALUE. IF G NOT = "09Y9Y9Y9Y9YZ09Y9Y9Y9Y9YZ09Y9Y9Y9Y9YZ" DISPLAY "INIT VALUE failed: " G "." DISPLAY " should be: " "09Y9Y9Y9Y9YZ09Y9Y9Y9Y9YZ09Y9Y9Y9Y9YZ." - * ADD 1 TO FAILED + ADD 1 TO FAILED + END-IF. + IF FAILED = ZERO + DISPLAY "All INITIALIZE tests passed." END-IF. - * IF FAILED = ZERO - * DISPLAY "All INITIALIZE tests passed." - * END-IF STOP RUN. ]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([$COMPILE -std=default prog.cob ], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [All INITIALIZE tests passed. +], []) AT_CLEANUP