Improvements

.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: |

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
 )

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) {

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);

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
 }
 

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);
 	}

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;

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++;

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

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