diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 4beeb50c3..f6bddef6d 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,4 +1,20 @@ +2024-02-26 David Declerck + + BUG #948: comparison with HIGH-VALUE in presence of collating sequences + * typeck.c: replace cob_refer_ascii and cob_refer_ebcdic by + ebcdic_to_ascii and ascii_to_ebcdic; add low_value and + high_value global variables to hold the low and high values + used by the program collating sequence; add load_collating_table + to load the tables; modify cb_validate_collating to call + load_collating_table and set low_value and high_value; + modify validate_alphabet to use the new tables + * cobc.h: export the new symbols defined in typeck.c + * codegen.c: replace hard-coded 0 and 255 / 0xff contants + with low_value and high_value where appropriate; adjust the + output_collating_tables function to use the tables and functions + defined in typeck.c + 2023-10-12 Fabrice Le Fessant * cobc.c, codegen.c: new option --include FILE, to #include diff --git a/cobc/cobc.h b/cobc/cobc.h index 7b5f30bbd..0d058f365 100644 --- a/cobc/cobc.h +++ b/cobc/cobc.h @@ -620,6 +620,13 @@ extern int yyparse (void); /* typeck.c */ extern size_t suppress_warn; /* no warnings for internal generated stuff */ +extern cob_u8_t ebcdic_to_ascii[256]; +extern cob_u8_t ascii_to_ebcdic[256]; +extern cob_u8_t low_value; +extern cob_u8_t high_value; + +void load_collating_tables (void); + /* error.c */ #define CB_MSG_STYLE_GCC 0 #define CB_MSG_STYLE_MSC 1U diff --git a/cobc/codegen.c b/cobc/codegen.c index ab323a4f9..8085a624c 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -2514,7 +2514,7 @@ output_low_value (void) if (gen_figurative & CB_NEED_LOW) { output ("static cob_field cob_all_low\t= "); output ("{1, "); - output ("(cob_u8_ptr)\"\\0\", "); + output ("(cob_u8_ptr)\"\\x%02x\", ", low_value); output ("&cob_all_attr};"); output_newline (); } @@ -2526,7 +2526,7 @@ output_high_value (void) if (gen_figurative & CB_NEED_HIGH) { output ("static cob_field cob_all_high\t= "); output ("{1, "); - output ("(cob_u8_ptr)\"\\xff\", "); + output ("(cob_u8_ptr)\"\\x%02x\", ", high_value); output ("&cob_all_attr};"); output_newline (); } @@ -2651,16 +2651,10 @@ output_colseq_table_field (const char * field_name, const char * table_name) static void output_collating_tables (void) { - cob_u8_t ebcdic_to_ascii[256]; - cob_u8_t ascii_to_ebcdic[256]; /* Load the collating tables if needed */ if (gen_ascii_ebcdic || gen_ebcdic_ascii) { - if (cob_load_collation (cb_ebcdic_table, - gen_ebcdic_ascii ? ebcdic_to_ascii : NULL, - gen_ascii_ebcdic ? ascii_to_ebcdic : NULL) < 0) { - cobc_err_exit (_("invalid parameter: %s"), "-febcdic-table"); - } + load_collating_tables (); } if (gen_native) { @@ -4274,9 +4268,9 @@ output_funcall_typed (struct cb_funcall *p, const char type) } else if (p->argv[1] == cb_zero) { output (") - '0')"); } else if (p->argv[1] == cb_low) { - output ("))"); + output (") - %d)", low_value); } else if (p->argv[1] == cb_high) { - output (") - 255)"); + output (") - %d)", high_value); } else if (CB_LITERAL_P (p->argv[1])) { output_char (") - ", CB_LITERAL (p->argv[1])->data[0], ")"); } else { @@ -5007,10 +5001,10 @@ output_initialize_to_value (struct cb_field *f, cb_tree x, output_figurative (x, f, ' ', init_occurs); return; } else if (value == cb_low) { - output_figurative (x, f, 0, init_occurs); + output_figurative (x, f, low_value, init_occurs); return; } else if (value == cb_high) { - output_figurative (x, f, 255, init_occurs); + output_figurative (x, f, high_value, init_occurs); return; } else if (value == cb_quote) { if (cb_flag_apostrophe) { @@ -10684,9 +10678,9 @@ output_class_name_definition (struct cb_class_name *p) } else if (x == cb_null) { vals[0] = 1; } else if (x == cb_low) { - vals[0] = 1; + vals[low_value] = 1; } else if (x == cb_high) { - vals[255] = 1; + vals[high_value] = 1; } else { size = CB_LITERAL (x)->size; data = CB_LITERAL (x)->data; diff --git a/cobc/typeck.c b/cobc/typeck.c index 7ca5db3f7..8e952b028 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -196,79 +196,12 @@ static const unsigned char expr_prio[256] = { static unsigned char expr_prio[256]; #endif -#ifdef COB_EBCDIC_MACHINE -/* EBCDIC referring to ASCII */ -static const unsigned char cob_refer_ascii[256] = { - 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, - 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, - 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, - 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, - 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, - 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, - 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, - 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, - 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, - 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, - 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, - 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, - 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, - 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, - 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, - 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, - 0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48, - 0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67, - 0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD, - 0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4, - 0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B, - 0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B, - 0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20, - 0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE, - 0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D, - 0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A, - 0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF, - 0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35, - 0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF, - 0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14, - 0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED, - 0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF -}; -#else -/* ASCII referring to EBCDIC */ -static const unsigned char cob_refer_ebcdic[256] = { - 0x00, 0x01, 0x02, 0x03, 0xEC, 0x09, 0xCA, 0x7F, - 0xE2, 0xD2, 0xD3, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, - 0x10, 0x11, 0x12, 0x13, 0xEF, 0xC5, 0x08, 0xCB, - 0x18, 0x19, 0xDC, 0xD8, 0x1C, 0x1D, 0x1E, 0x1F, - 0xB7, 0xB8, 0xB9, 0xBB, 0xC4, 0x0A, 0x17, 0x1B, - 0xCC, 0xCD, 0xCF, 0xD0, 0xD1, 0x05, 0x06, 0x07, - 0xD9, 0xDA, 0x16, 0xDD, 0xDE, 0xDF, 0xE0, 0x04, - 0xE3, 0xE5, 0xE9, 0xEB, 0x14, 0x15, 0x9E, 0x1A, - 0x20, 0xC9, 0x83, 0x84, 0x85, 0xA0, 0xF2, 0x86, - 0x87, 0xA4, 0xD5, 0x2E, 0x3C, 0x28, 0x2B, 0xB3, - 0x26, 0x82, 0x88, 0x89, 0x8A, 0xA1, 0x8C, 0x8B, - 0x8D, 0xE1, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E, - 0x2D, 0x2F, 0xB2, 0x8E, 0xB4, 0xB5, 0xB6, 0x8F, - 0x80, 0xA5, 0x7C, 0x2C, 0x25, 0x5F, 0x3E, 0x3F, - 0xBA, 0x90, 0xBC, 0xBD, 0xBE, 0xF3, 0xC0, 0xC1, - 0xC2, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22, - 0xC3, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, - 0x68, 0x69, 0xAE, 0xAF, 0xC6, 0xC7, 0xC8, 0xF1, - 0xF8, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, - 0x71, 0x72, 0xA6, 0xA7, 0x91, 0xCE, 0x92, 0xA9, - 0xE6, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, - 0x79, 0x7A, 0xAD, 0xA8, 0xD4, 0x5B, 0xD6, 0xD7, - 0x9B, 0x9C, 0x9D, 0xFA, 0x9F, 0xB1, 0xB0, 0xAC, - 0xAB, 0xFC, 0xAA, 0xFE, 0xE4, 0x5D, 0xBF, 0xE7, - 0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, - 0x48, 0x49, 0xE8, 0x93, 0x94, 0x95, 0xA2, 0xED, - 0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, - 0x51, 0x52, 0xEE, 0x96, 0x81, 0x97, 0xA3, 0x98, - 0x5C, 0xF0, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, - 0x59, 0x5A, 0xFD, 0xF5, 0x99, 0xF7, 0xF6, 0xF9, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, - 0x38, 0x39, 0xDB, 0xFB, 0x9A, 0xF4, 0xEA, 0xFF -}; -#endif +/* ASCII/EBCDIC translation tables */ + +cob_u8_t ebcdic_to_ascii[256]; +cob_u8_t ascii_to_ebcdic[256]; +cob_u8_t low_value = 0; +cob_u8_t high_value = 255; /* System routines */ @@ -3804,6 +3737,19 @@ 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 (cb_tree collating_sequence) { @@ -3819,17 +3765,33 @@ cb_validate_collating (cb_tree collating_sequence) cb_name (collating_sequence)); return 1; } + +#ifdef COB_EBCDIC_MACHINE + if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_ASCII) { + load_collating_tables (); + low_value = ascii_to_ebcdic[0x00]; + high_value = ascii_to_ebcdic[0xff]; + } +#else + if (CB_ALPHABET_NAME (x)->alphabet_type == CB_ALPHABET_EBCDIC) { + load_collating_tables (); + low_value = ebcdic_to_ascii[0x00]; + high_value = ebcdic_to_ascii[0xff]; + } +#endif + if (CB_ALPHABET_NAME (x)->alphabet_type != CB_ALPHABET_CUSTOM) { return 0; } if (CB_ALPHABET_NAME (x)->low_val_char) { cb_low = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_low)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char; + CB_LITERAL(cb_low)->data[0] = low_value = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char; CB_LITERAL(cb_low)->all = 1; } + if (CB_ALPHABET_NAME (x)->high_val_char != 255){ cb_high = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_high)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; + CB_LITERAL(cb_high)->data[0] = high_value = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; CB_LITERAL(cb_high)->all = 1; } return 0; @@ -3854,8 +3816,9 @@ validate_alphabet (cb_tree alphabet) if (ap->alphabet_type == CB_ALPHABET_ASCII) { for (n = 0; n < 256; n++) { #ifdef COB_EBCDIC_MACHINE - ap->values[n] = (int)cob_refer_ascii[n]; - ap->alphachr[n] = (int)cob_refer_ascii[n]; + load_collating_tables (); + ap->values[n] = (int)ascii_to_ebcdic[n]; + ap->alphachr[n] = (int)ascii_to_ebcdic[n]; #else ap->values[n] = n; ap->alphachr[n] = n; @@ -3871,8 +3834,9 @@ validate_alphabet (cb_tree alphabet) ap->values[n] = n; ap->alphachr[n] = n; #else - ap->values[n] = (int)cob_refer_ebcdic[n]; - ap->alphachr[n] = (int)cob_refer_ebcdic[n]; + load_collating_tables (); + ap->values[n] = (int)ebcdic_to_ascii[n]; + ap->alphachr[n] = (int)ebcdic_to_ascii[n]; #endif } return; @@ -4214,6 +4178,8 @@ cb_validate_program_environment (struct cb_program *prog) /* Reset HIGH/LOW-VALUES */ cb_low = cb_norm_low; cb_high = cb_norm_high; + low_value = 0; + high_value = 255; /* Check and generate SYMBOLIC clauses */ for (l = prog->symbolic_char_list; l; l = CB_CHAIN (l)) { diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 18b32583d..d3106d6eb 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -14631,3 +14631,117 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) AT_CHECK([$COBCRUN prog], [0], [OKOKOKOKOK], []) AT_CLEANUP + + + +AT_SETUP([LOW/HIGH-VALUE when using non-native program collating sequence]) +AT_KEYWORDS([LOW-VALUE HIGH-VALUE ALPHABET EBCDIC ASCII]) + +AT_DATA([prog1.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + OBJECT-COMPUTER. x86, + PROGRAM COLLATING SEQUENCE IS alpha-custom. + SPECIAL-NAMES. + ALPHABET alpha-custom IS + 64 THRU 1 + 65 THRU 192 + 256 THRU 193. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + STOP RUN. +]) + +AT_CHECK([$COMPILE prog1.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog1], [0], [LOW-VALUE: 064 HIGH-VALUE: 193], []) + +AT_DATA([prog2.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 LV PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + STOP RUN. +]) + +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog2.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [LOW-VALUE: 001 HIGH-VALUE: 160], []) + +AT_DATA([prog3.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 LV PIC 999. + 01 HV PIC 999. + PROCEDURE DIVISION. + MOVE FUNCTION ORD (LOW-VALUE) TO LV. + MOVE FUNCTION ORD (HIGH-VALUE) TO HV. + DISPLAY "LOW-VALUE: " LV + " HIGH-VALUE: " HV WITH NO ADVANCING. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fdefault-colseq=EBCDIC -febcdic-table=ebcdic500_latin1 prog3.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], [LOW-VALUE: 001 HIGH-VALUE: 160], []) + +AT_DATA([prog4.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. + PROCEDURE DIVISION. + IF "X" < HIGH-VALUE + DISPLAY "X < HIGH-VALUE" WITH NO ADVANCING + ELSE + DISPLAY "X > HIGH-VALUE" WITH NO ADVANCING + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE -febcdic-table=ebcdic500_latin1 prog4.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog4], [0], [X < HIGH-VALUE], []) + +AT_DATA([prog5.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + IF "X" < HIGH-VALUE + DISPLAY "X < HIGH-VALUE" WITH NO ADVANCING + ELSE + DISPLAY "X > HIGH-VALUE" WITH NO ADVANCING + END-IF. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fdefault-colseq=EBCDIC -febcdic-table=ebcdic500_latin1 prog5.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog5], [0], [X < HIGH-VALUE], []) + +AT_CLEANUP