From 057d3e5f38382919cad26ce26bbbb6f7defcfc0a Mon Sep 17 00:00:00 2001 From: David Declerck Date: Tue, 5 Nov 2024 12:46:02 +0100 Subject: [PATCH] Improvements --- .github/workflows/windows-msvc.yml | 6 +--- build_windows/makedist.cmd | 2 +- cobc/cobc.c | 4 +++ cobc/codegen.c | 6 ---- cobc/scanner.l | 19 +----------- cobc/tree.c | 6 ++-- cobc/tree.h | 2 ++ cobc/typeck.c | 48 ++++++++++++----------------- tests/testsuite.src/run_misc.at | 8 ++++- tests/testsuite.src/syn_literals.at | 2 +- 10 files changed, 41 insertions(+), 62 deletions(-) diff --git a/.github/workflows/windows-msvc.yml b/.github/workflows/windows-msvc.yml index 03211301c..0a2e7d800 100644 --- a/.github/workflows/windows-msvc.yml +++ b/.github/workflows/windows-msvc.yml @@ -178,18 +178,14 @@ jobs: # sed -i '/AT_SETUP(\[runtime check: write to internal storage (1)\])/a AT_SKIP_IF(\[true\])' tests/testsuite.src/run_misc.at sed -i '/run_misc/{N;/write to internal storage (1)/{N;N;N;N;s/traceon/traceon; echo "workflow:1">"$at_check_line_file"; at_fn_check_skip 77/;}}' tests/testsuite - # Fail two tests that behave differently under MSVC Debug + # Fail tests that behave differently under MSVC Debug # - System routine CBL_GC_HOSTED: fails because libcob is linked with the debug version # of the C runtime while the generated module is linked with the release version - # - PROGRAM COLLATING SEQUENCE: fails because of a data loss in a cast, due - # to lack of specific handling of LOW/HIGH-VALUE for NATIONAL alphabets - # (see typeck.c:cb_validate_collating) - name: Adjust testsuite for Debug target if: ${{ matrix.target == 'Debug' }} shell: C:\shells\msys2bash.cmd {0} run: | sed -i '/run_extensions/{N;/System routine CBL_GC_HOSTED/{N;s/at_xfail=no/at_xfail=yes/;}}' tests/testsuite - sed -i '/syn_definition/{N;/PROGRAM COLLATING SEQUENCE/{N;s/at_xfail=no/at_xfail=yes/;}}' tests/testsuite - name: Run testsuite run: | diff --git a/build_windows/makedist.cmd b/build_windows/makedist.cmd index 65a9c0282..de6ce2291 100644 --- a/build_windows/makedist.cmd +++ b/build_windows/makedist.cmd @@ -120,7 +120,7 @@ if exist "%cob_source_path%doc\*.html" ( echo Copying configuration files... mkdir config -set "config_ext_list=conf conf-inc words cfg" +set "config_ext_list=conf conf-inc words cfg ttbl" for %%f in (%config_ext_list%) do ( copy "%cob_source_path%config\*.%%f" config\ 1>nul ) diff --git a/cobc/cobc.c b/cobc/cobc.c index 34b38a8da..052af95d2 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -4230,6 +4230,10 @@ process_command_line (const int argc, char **argv) cb_flag_alt_ebcdic ? "alternate" : "default"); } + if (cob_load_collation (cb_ebcdic_table, ebcdic_to_ascii, ascii_to_ebcdic) < 0) { + cobc_err_exit (_("invalid parameter: %s"), "-febcdic-table"); + } + /* Exit on missing options */ #ifdef COB_INTERNAL_XREF if (cb_listing_xref && !cb_listing_outputfile) { diff --git a/cobc/codegen.c b/cobc/codegen.c index 838fe304c..8a5e124c6 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -2652,12 +2652,6 @@ output_colseq_table_field (const char * field_name, const char * table_name) static void output_collating_tables (void) { - - /* Load the collating tables if needed */ - if (gen_ascii_ebcdic || gen_ebcdic_ascii) { - load_collating_tables (); - } - if (gen_native) { output_storage ("\n/* NATIVE table */\n"); output_colseq_table ("cob_native", NULL); diff --git a/cobc/scanner.l b/cobc/scanner.l index 878e660e9..dd7e21c52 100644 --- a/cobc/scanner.l +++ b/cobc/scanner.l @@ -1347,10 +1347,6 @@ static cob_u8_t scan_ebcdic_char (int c) { char buff[10]; /* Arbitrary limit, mostly for error-reporting */ -#ifndef COB_EBCDIC_MACHINE - static cob_u8_t ebcdic_to_ascii[256] ; - static int ebcdic_to_ascii_initialized = 0 ; -#endif unsigned int j = 0; do { buff[j++] = (char)c; @@ -1367,20 +1363,7 @@ scan_ebcdic_char (int c) #ifdef COB_EBCDIC_MACHINE return (cob_u8_t) c; #else - if (!ebcdic_to_ascii_initialized ) { - if (cob_load_collation (cb_ebcdic_table, ebcdic_to_ascii, NULL) < 0) { - cb_error (_("invalid parameter: %s"), "-febcdic-table"); - ebcdic_to_ascii_initialized = -1; - } else { - ebcdic_to_ascii_initialized = 1; - } - } - - if (ebcdic_to_ascii_initialized > 0) { - return ebcdic_to_ascii[c]; - } else { - return '?'; - } + return ebcdic_to_ascii[c]; #endif } diff --git a/cobc/tree.c b/cobc/tree.c index 906027052..6e781ed9c 100644 --- a/cobc/tree.c +++ b/cobc/tree.c @@ -2193,8 +2193,10 @@ cb_build_program (struct cb_program *last_program, const int nest_level) p->decimal_point = '.'; p->currency_symbol = '$'; p->numeric_separator = ','; - p->low_value = '\0'; - p->high_value = '\xff'; + p->low_value = 0; + p->high_value = 255; + p->low_value_n = 0; + p->high_value_n = 65535; if (cb_call_extfh) { p->extfh = cobc_parse_strdup (cb_call_extfh); } diff --git a/cobc/tree.h b/cobc/tree.h index 975cc28f1..0c3d0679c 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1918,6 +1918,8 @@ struct cb_program { unsigned char numeric_separator; /* ',' or '.' */ cob_u8_t low_value; /* Low-value for this program */ cob_u8_t high_value; /* High-value for this program */ + cob_u16_t low_value_n; /* National Low-value */ + cob_u16_t high_value_n; /* National High-value */ 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; diff --git a/cobc/typeck.c b/cobc/typeck.c index 60f9cd409..b0bbd24b9 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -3750,19 +3750,6 @@ get_value (cb_tree x) } } -void -load_collating_tables (void) -{ - static int coltab_loaded = 0; - if (coltab_loaded) { - return; - } - if (cob_load_collation (cb_ebcdic_table, ebcdic_to_ascii, ascii_to_ebcdic) < 0) { - cobc_err_exit (_("invalid parameter: %s"), "-febcdic-table"); - } - coltab_loaded = 1; -} - static int cb_validate_collating (struct cb_program *prog, cb_tree collating_sequence) { @@ -3781,33 +3768,40 @@ cb_validate_collating (struct cb_program *prog, cb_tree collating_sequence) #ifdef COB_EBCDIC_MACHINE if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_ASCII) { - load_collating_tables (); prog->low_value = ascii_to_ebcdic[0x00]; prog->high_value = ascii_to_ebcdic[0xff]; #else if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_EBCDIC) { - load_collating_tables (); prog->low_value = ebcdic_to_ascii[0x00]; prog->high_value = ebcdic_to_ascii[0xff]; #endif } else if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_CUSTOM) { - prog->low_value = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char; - prog->high_value = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; + if (CB_ALPHABET_NAME (x)->alphabet_target == CB_ALPHABET_ALPHANUMERIC) { + prog->low_value = (cob_u8_t)CB_ALPHABET_NAME (x)->low_val_char; + prog->high_value = (cob_u8_t)CB_ALPHABET_NAME (x)->high_val_char; + } else /* CB_ALPHABET_NATIONAL */ { + prog->low_value_n = (cob_u16_t)CB_ALPHABET_NAME (x)->low_val_char; + prog->high_value_n = (cob_u16_t)CB_ALPHABET_NAME (x)->high_val_char; + } } else { return 0; } - if (prog->low_value) { - cb_low = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_low)->data[0] = prog->low_value; - CB_LITERAL(cb_low)->all = 1; + if (CB_ALPHABET_NAME (x)->alphabet_target == CB_ALPHABET_ALPHANUMERIC) { + if (prog->low_value) { + cb_low = cb_build_alphanumeric_literal ("\0", (size_t)1); + CB_LITERAL(cb_low)->data[0] = prog->low_value; + CB_LITERAL(cb_low)->all = 1; + } + if (prog->high_value != 255){ + cb_high = cb_build_alphanumeric_literal ("\0", (size_t)1); + CB_LITERAL(cb_high)->data[0] = prog->high_value; + CB_LITERAL(cb_high)->all = 1; + } + } else /* CB_ALPHABET_NATIONAL */ { + /* TODO: LOW/HIGH-VALUE for national */ } - if (prog->high_value != 255){ - cb_high = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_high)->data[0] = prog->high_value; - CB_LITERAL(cb_high)->all = 1; - } return 0; } @@ -3860,7 +3854,6 @@ validate_alphabet (cb_tree alphabet) register int *entry = ap->values; for (n = 0; n < COB_MAX_CHAR_ALPHANUMERIC + 1; n++) { #ifdef COB_EBCDIC_MACHINE - load_collating_tables (); *entry = (int)ascii_to_ebcdic[n]; #else *entry = n; @@ -3885,7 +3878,6 @@ validate_alphabet (cb_tree alphabet) #ifdef COB_EBCDIC_MACHINE *entry = n; #else - load_collating_tables (); *entry = (int)ebcdic_to_ascii[n]; #endif entry++; diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 483296aeb..2cd298588 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -4079,6 +4079,12 @@ AT_KEYWORDS([runmisc default-colseq]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-ebcdic. + SPECIAL-NAMES. + ALPHABET alpha-ebcdic IS EBCDIC. DATA DIVISION. WORKING-STORAGE SECTION. 01 TAB. @@ -4099,7 +4105,7 @@ AT_DATA([prog.cob], [ STOP RUN. ]) -AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 -fdefault-colseq=EBCDIC prog.cob], [0], [], []) +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP diff --git a/tests/testsuite.src/syn_literals.at b/tests/testsuite.src/syn_literals.at index f4d8f8a5d..ea9d3d7da 100644 --- a/tests/testsuite.src/syn_literals.at +++ b/tests/testsuite.src/syn_literals.at @@ -1556,7 +1556,7 @@ AT_CHECK([$COMPILE prog2.cob], [0], [], ]) AT_CHECK([$COMPILE -febcdic-symbolic-characters -febcdic-table=dummyNotThere prog2.cob], [1], [], [libcob: error: can't open translation table 'dummyNotThere' -prog2.cob:5: error: invalid parameter: -febcdic-table +cobc: error: invalid parameter: -febcdic-table ]) AT_CLEANUP