https://gcc.gnu.org/g:e47eccbe6d118023e4fe83bde14075729c40e030
commit r17-4536-ge47eccbe6d118023e4fe83bde14075729c40e030 Author: Robert Dubner <[email protected]> Date: Mon Sep 21 13:03:11 2026 -0400 cobol: Improve speed of numeric-edited formatting. The speed of converting numerical strings to numeric-edited variables has been improved by moving run-time PICTURE processing to compile time. gcc/cobol/ChangeLog: * genapi.cc (actually_create_the_static_field): Use the new expand_expanded routine. * symbols.cc (expand_picture): Add space to accommodate the six additional pre-processing characters. (expand_expanded): Append compile-time data to the end of numeric- edited PICTURE strings. * symbols.h (redefined_token): Formatting. (class current_tokens_t): Formatting. (expand_expanded): New declaration. * util.cc (cbl_field_t::encode_numeric): Use expand_expanded(). libgcobol/ChangeLog: * libgcobol.cc (int128_to_field): Remove rdigits formal parameter. (__gg__int128_to_ascii_numeric_display): Likewise. * valconv.cc (__gg__string_to_numeric_edited): Complete rewrite to use parameters appended by expand_expanded(). * valconv.h: Remove rdigits format parameter from __gg__int128_to_ascii_numeric_display. gcc/testsuite/ChangeLog: * cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob: New test. * cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.out: New test. Diff: --- gcc/cobol/genapi.cc | 5 + gcc/cobol/symbols.cc | 223 ++++++++++++ gcc/cobol/symbols.h | 22 +- gcc/cobol/util.cc | 5 +- ...INFO__get_program_name_-_functions_0_and_2_.cob | 71 ++++ ...INFO__get_program_name_-_functions_0_and_2_.out | 3 + libgcobol/libgcobol.cc | 8 +- libgcobol/valconv.cc | 390 ++++++++------------- libgcobol/valconv.h | 1 - 9 files changed, 466 insertions(+), 262 deletions(-) diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 5d7d553b9d8b..e3753fd77099 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -14431,7 +14431,12 @@ actually_create_the_static_field( cbl_field_t *new_var, } tree offset = build_int_cst_type(SIZE_T, new_var->offset); tree name = gg_string_literal(new_var->name); + char *expanded = expand_picture(new_var->data.picture); + if( new_var->type == FldNumericEdited ) + { + expand_expanded(expanded); + } tree picture = gg_string_literal(expanded); free(expanded); tree initial; diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 6d96ba311b6a..c41e0b8ff2a3 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -4798,6 +4798,12 @@ expand_picture(const char *picture) // The caller should free() the return value. assert(strlen(picture) < PICTURE_MAX); // guaranteed by picset() in scanner size_t retval_length = PICTURE_MAX; + + // In the expand_expanded routine, we are going to tack on some additional + // characters in order to speed up compile-time processin. + static const int PICTURE_EXTRA = 6; + retval_length += PICTURE_EXTRA; + char *retval = static_cast<char *>(xmalloc(retval_length)); int ch; @@ -4909,9 +4915,226 @@ expand_picture(const char *picture) break; } } + + // AD HOC FIX for an improper trailing space + char *pspace = strchr(retval, ascii_space); + if( pspace ) + { + *pspace = NULLCH; + } + return retval; } +void +expand_expanded(char *expanded) + { + if(strlen(expanded) == 0) + { + return; + } + + unsigned char *dest = reinterpret_cast<unsigned char *>(expanded); + + /* In order to make __gg__string_to_numeric_edited() run quickly, we are + going to process the expanded picture string especially for it. What we + do here: + + Convert B to space, taking care not to touch a final 'DB' + + Find the currency picture symbol + + Find the span of any '$$', '++', '--' 'Z', and '*' runs. + + For any '$$', '++' and '--' runs, replace the first such char with a + space, and all the others with '9' + + For any 'Z' and '*' runs, replace all the characters with '9'. + + Figure out if any of the original picture characters are '9'. + + That information gets encoded into six characters that are appended to + the modified string. + + Offset 0: The currency character + Offset 1: The floating character (space if empty) + Offset 2-3: The starting index of the float. + Offset 3-4: The one-past-the-end index of the float. + + When there are '9' characters in the original, the 0x40 bit of offset 2 + is turned on, turning '0'-'9' into 'q'-'y' + + Is everybody ready? Then we'll begin. */ + + int length_d = strlen(expanded); + + unsigned char currency_char = ascii_space; + // Note that the currency_picture can be upper- or lower-case, and mean + // separate things in IBM. In ISO COBOL, the comparison is case-insensitive. + + unsigned floating_char = ascii_space; + int leftmost_float = -1; + int rightmost_float = -1; // This is a one-past-the-end index + + bool got_nines = false; + + for(int i=0; i<length_d; i++) + { + int ch = (unsigned int)dest[i] & 0xFF; + if( !__gg__currency_signs[ch].empty() ) + { + currency_char = ch; + break; + } + } + + for(int i=0; i<length_d; i++) + { + if( dest[i] == ascii_9 ) + { + got_nines = true; + break; + } + } + + if( dest[0] == ascii_B ) + { + dest[0] = ascii_space; + } + for(int i=1; i<length_d; i++) + { + if( dest[i] == ascii_B && dest[i-1] != ascii_D && dest[i-1] != ascii_d ) + { + dest[i] = ascii_space; + } + } + + if( currency_char != ascii_space ) + { + leftmost_float = + static_cast<unsigned char *>(memchr(dest, currency_char, length_d)) - dest; + rightmost_float = + static_cast<unsigned char *>(memrchr(dest, currency_char, length_d)) - dest + 1; + if( rightmost_float > leftmost_float+1 ) + { + floating_char = currency_char; + // Turn the first floating character into a space + dest[leftmost_float] = ascii_space; + for(int i=leftmost_float+1; i<rightmost_float; i++) + { + // Of the remainder, turn all floating characters into '9', so that + // they will be filled with numerical data from 'source'. + if( dest[i] == floating_char ) + { + dest[i] = ascii_9; + } + } + } + else + { + leftmost_float = rightmost_float = -1; + } + } + + if( memchr(dest, ascii_minus, length_d) ) + { + int leftmost = + static_cast<unsigned char *>(memchr(dest, ascii_minus, length_d)) - dest; + int rightmost = + static_cast<unsigned char *>(memrchr(dest, ascii_minus, length_d)) - dest + 1; + if( rightmost > leftmost+1 ) + { + floating_char = ascii_minus; + leftmost_float = leftmost; + rightmost_float = rightmost; + for(int i=leftmost_float+1; i<rightmost_float; i++) + { + // Of the remainder, turn all floating characters into '9', so that + // they will be filled with numerical data from 'source'. + if( dest[i] == floating_char ) + { + dest[i] = ascii_9; + } + } + } + } + + if( memchr(dest, ascii_plus, length_d) ) + { + int leftmost = + static_cast<unsigned char *>(memchr(dest, ascii_plus, length_d)) - dest; + int rightmost = + static_cast<unsigned char *>(memrchr(dest, ascii_plus, length_d)) - dest + 1; + if( rightmost > leftmost+1 ) + { + floating_char = ascii_plus; + leftmost_float = leftmost; + rightmost_float = rightmost; + for(int i=leftmost_float+1; i<rightmost_float; i++) + { + // Of the remainder, turn all floating characters into '9', so that + // they will be filled with numerical data from 'source'. + if( dest[i] == floating_char ) + { + dest[i] = ascii_9; + } + } + } + } + + if( memchr(dest, ascii_asterisk, length_d) ) + { + floating_char = ascii_asterisk; + leftmost_float = + static_cast<unsigned char *>(memchr(dest, ascii_asterisk, length_d)) - dest; + rightmost_float = + static_cast<unsigned char *>(memrchr(dest, ascii_asterisk, length_d)) - dest + 1; + for(int i=leftmost_float; i<rightmost_float; i++) + { + // Turn all floating characters into '9', so that + // they will be filled with numerical data from 'source'. + if( dest[i] == floating_char ) + { + dest[i] = ascii_9; + } + } + } + + if( memchr(dest, ascii_Z, length_d) ) + { + floating_char = ascii_Z; + leftmost_float = + static_cast<unsigned char *>(memchr(dest, ascii_Z, length_d)) - dest; + rightmost_float = + static_cast<unsigned char *>(memrchr(dest, ascii_Z, length_d)) - dest + 1; + for(int i=leftmost_float; i<rightmost_float; i++) + { + // Turn all floating characters into '9', so that + // they will be filled with numerical data from 'source'. + if( dest[i] == floating_char ) + { + dest[i] = ascii_9; + } + } + } + + char extra[7] = " "; + extra[0] = currency_char; + if( floating_char != ascii_space ) + { + extra[1] = floating_char; + extra[2] = leftmost_float / 10 + ascii_0; + extra[3] = leftmost_float % 10 + ascii_0; + extra[4] = rightmost_float / 10 + ascii_0; + extra[5] = rightmost_float % 10 + ascii_0; + if( got_nines ) + { + extra[2] |= 0x40; + } + } + strcat(expanded, extra); + } + int length_of_picture(const char *picture) { diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 3887b275b7b0..d1864b1fdde6 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -46,6 +46,7 @@ #include <string> #include <vector> +// The ISO spec says there is a #define PICTURE_MAX 64 extern const char *numed_message; @@ -2970,7 +2971,7 @@ int redefined_token( const cbl_name_t name, int token ); * intrinsic functions. * * tokens and token_names are defined in a token_names.h, generated from parse.h. - * + * * - token_names converts a yytokentype enum to a string form of * its name as defined in the parser. It is used by keyword_str. * - tokens imperfectly maps a lowercase form of the token name to its value. @@ -2981,16 +2982,16 @@ int redefined_token( const cbl_name_t name, int token ); * EQUATE adds a new name for a token in tokens. * UNDEFINE removes a name from tokens. * SUBSTITUTE is EQUATE for the first name and UNDEFINE for the second. - * RESERVE adds a new name to tokens with the invalid value -42. + * RESERVE adds a new name to tokens with the invalid value -42. * * The generated lexer of course uses static strings and is thus unaffected by * COBOL-WORDS. The parser accesses the generated lexer via a mediation layer * that deals with the CDF. That is where COBOL-WORDS are applied. * - * There are unsolved problems. - * 1. Some tokens are lexed as more than one text word, or depend on context. - * For example OBJECT COMPUTER and IDENTIFICATION DIVISION. If the user - * substitutes COMPUTING-MACHINE COMPUTER, lexing will fail. + * There are unsolved problems. + * 1. Some tokens are lexed as more than one text word, or depend on context. + * For example OBJECT COMPUTER and IDENTIFICATION DIVISION. If the user + * substitutes COMPUTING-MACHINE COMPUTER, lexing will fail. * 2. Semantic values are known only to the lexer. Some tokens carry a value * representing their context. For example, both INVALID and NOT INVALID @@ -3000,7 +3001,7 @@ int redefined_token( const cbl_name_t name, int token ); * assign it the value "BOGUS". When that string is found by * redefined_token and mapped to INVALID (so the parser can parse it) the * semantic value is lost. - * + * * 3. Some names are not NAME tokens, depending on context. That subtlety is * also lost. * @@ -3105,7 +3106,7 @@ class current_tokens_t { return true; } /* - * name may be: + * name may be: * 1. just a name, return the input token. * 2. reserved with -42 token * 3. a user-defined substitute or alias for a token @@ -3144,7 +3145,7 @@ class current_tokens_t { return tokens.find(name, include_intrinsics); } bool equate( const cbl_loc_t& loc, const cbl_name_t keyword, const cbl_name_t alias ) { - int token; + int token; if( 0 == (token = keyword_tok(keyword, true)) ) { if( 0 == (token = binary_integer_usage_of(keyword)) ) { @@ -3165,7 +3166,7 @@ class current_tokens_t { return tokens.undefine(loc, keyword); } bool substitute( const cbl_loc_t& loc, const cbl_name_t keyword, const cbl_name_t alias ) { - int token; + int token; if( 0 == (token = keyword_tok(keyword, true)) ) { if( 0 == (token = binary_integer_usage_of(keyword)) ) { error_msg(loc, "SUBSTITUTE: not a reserved word: %qs", keyword); @@ -3293,6 +3294,7 @@ cbl_field_t *new_alphanumeric(const cbl_name_t name=nullptr, cbl_encoding_t encoding=no_encoding_e ); char *expand_picture(const char *picture); +void expand_expanded(char *picture); // ENABLE_HIJACKING allows for code generation to be "hijacked" when the // program-id is "dubner_h" or "hijack_h". See the mainline code in genapi.cc. diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index 70122334090c..e45252259816 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -1936,9 +1936,12 @@ cbl_field_t::encode_numeric( const char input[], cbl_loc_t loc ) { // By the time you read this, this next statement ought to be // obsolete. See RT issue 3682. expanded[char_capacity()] = '\0'; + if( type == FldNumericEdited ) + { + expand_expanded(expanded); + } __gg__string_to_numeric_edited( reinterpret_cast<char *>(retval), ach, - data.rdigits, negative, expanded); free(expanded); diff --git a/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob b/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob new file mode 100644 index 000000000000..5b2f160397e8 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.cob @@ -0,0 +1,71 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.out" } + + copy "cblproto.cpy". + identification division. + program-id. prog. + data division. + working-storage section. + copy "cbltypes.cpy". + 01 param-block type cblt-prog-info-params value zeros. + 77 fn pic x(4) comp-5. + 77 status-code pic x(2) comp-5. + 77 buf pic x(128). + 77 buflen pic x(4) comp-5. + procedure division. + move length of param-block to cblte-gpi-size. + + * allocate handle + move 7 to cblte-gpi-flags. + move 0 to fn. + move length of buf to buflen. + call "CBL_GET_PROGRAM_INFO" using + by value fn + by reference param-block + buf + buflen + returning status-code. + + if status-code <> 0 + display "CBL_GET_PROGRAM_INFO failed with " status-code + goback + end-if. + + display "buf is '" buf "'". + + * retrieve program name from handle + move 6 to cblte-gpi-flags. + move 2 to fn. + move x"00" to buf. + call "CBL_GET_PROGRAM_INFO" using + by value fn + by reference param-block + buf + buflen + returning status-code. + + if status-code <> 0 + display "CBL_GET_PROGRAM_INFO failed with " status-code + goback + end-if. + + display "buf from handle is '" buf "'". + + * close handle + move 0 to cblte-gpi-flags. + move 3 to fn. + call "CBL_GET_PROGRAM_INFO" using + by value fn + by reference param-block + buf + buflen + returning status-code. + + if status-code <> 0 + display "CBL_GET_PROGRAM_INFO failed with " status-code + goback + end-if. + end program prog. + diff --git a/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.out b/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.out new file mode 100644 index 000000000000..c86d093d7678 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/CBL_GET_PROGRAM_INFO__get_program_name_-_functions_0_and_2_.out @@ -0,0 +1,3 @@ +buf is 'prog' +buf from handle is 'prog' + diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index f436e822889d..4332d7ddee0d 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -2140,7 +2140,6 @@ int128_to_field(cblc_field_t *var, // Convert that string according to the PICTURE clause __gg__string_to_numeric_edited(as_chars(location), ach, - target_rdigits, is_negative, var->picture); size_t outlength; @@ -2309,10 +2308,9 @@ __gg__int128_to_ascii_numeric_display(const cblc_field_t *var, // Convert that string according to the PICTURE clause __gg__string_to_numeric_edited(as_chars(location), - ach, - var->rdigits, - is_negative, - var->picture); + ach, + is_negative, + var->picture); } return size_error; } diff --git a/libgcobol/valconv.cc b/libgcobol/valconv.cc index 21e89f437ddb..83bdaf09cbae 100644 --- a/libgcobol/valconv.cc +++ b/libgcobol/valconv.cc @@ -138,12 +138,12 @@ __gg__alphabet_create( cbl_encoding_t encoding, extern "C" void -__gg__string_to_numeric_edited( char * const dest, +__gg__string_to_numeric_edited( char * const dest_, const char *source, // In source characters - int /*rdigits*/, int is_negative, const char *picture) { + unsigned char *dest = reinterpret_cast<unsigned char *>(dest_); // This routine operates in ASCII space. Life is hard enough without trying // to do this in EBCDIC, too. So, 'source' and 'picture' are assumed to be // CP1252 @@ -159,8 +159,14 @@ __gg__string_to_numeric_edited( char * const dest, // Make a copy of the PICTURE string in the destination space. The picture // is supposed to be the same length as the char_capacity of the variable. - const int length_s = strlen(source); - const int length_d = strlen(picture); + + // We subtract the length of the extra characters that were appended to the + // adjusted PICTURE string. + + static const int MAX_POSSIBLE = 64 + 6; // See PICTURE_MAX in symbols.h + + const int length_d = strlen(picture) - 6; + assert(length_d < MAX_POSSIBLE && length_d >= 0); memcpy(dest, picture, length_d); /* We have two kinds of floating insertion: currency and sign. @@ -183,105 +189,72 @@ __gg__string_to_numeric_edited( char * const dest, // We need to know if we have a currency picture symbol in this string: // This is the currency character in the PICTURE - unsigned char currency_char = NULLCH; + unsigned char currency_char; const char *currency_text = NULL; // This is the text we output when // // encountering the currency_picture // // character // Note that the currency_picture can be upper- or lower-case, and mean // separate things in IBM. In ISO COBOL, the comparison is case-insensitive. - // This is the character for a floating sign - char sign_char; - - // In the following limits, all of the rightmosts are past-the-end indexes - - int leftmost_currency = -1; - int rightmost_currency = -1; - - int leftmost_sign = -1; - int rightmost_sign = -1; - - int leftmost_asterisk = -1; - int rightmost_asterisk = -1; - int zeroed_asterisk = 0; - - int leftmost_z = -1; - int rightmost_z = -1; - int zeroed_z = 0; - + unsigned char floating_char; + int leftmost_float = -1; + int rightmost_float = -1; // This is a one-past-the-end index + bool got_nines = false; int leftmost_nonzero = -1; - int decimal_position = -1; - // This is the first pass. Because the currency + unsigned const char *extra = + reinterpret_cast<unsigned const char *>(picture+length_d); + currency_char = extra[0]; + currency_text = __gg__currency_signs[currency_char].c_str(); + + floating_char = extra[1] != ascii_space ? extra[1] : NULLCH; + if( floating_char != ascii_space ) + { + leftmost_float = (extra[2] & 0xF) * 10 + (extra[3] & 0xF); + rightmost_float = (extra[4] & 0xF) * 10 + (extra[5] & 0xF); + } + got_nines = !!(extra[2] & 0x40); + int index_s = 0; for(int i=0; i<length_d; i++) { - int ch = (unsigned int)dest[i] & 0xFF; - if( ! __gg__currency_signs[ch].empty() ) - { - currency_char = ch; - currency_text = __gg__currency_signs[ch].c_str(); - if( leftmost_currency == -1 ) - { - leftmost_currency = i; - } - else - { - // This is not the leftmost currency character, so it is where a digit - // goes. - dest[i] = source[index_s++]; - if( leftmost_nonzero == -1 && dest[i] != ascii_zero ) - { - leftmost_nonzero = i; - } - } - rightmost_currency = i+1; - } + unsigned char ch = dest[i]; + if( ch == currency_char ) { - // We have already handled the currency char. - continue; + // Arriving here means we have hit a singleton currency character. Since + // it is not part of a floating currency stream, the currency text goes + // here. + memcpy(dest + i - (strlen(currency_text)-1), + currency_text, + strlen(currency_text)); } + switch(ch) { case ascii_minus: case ascii_plus: - { + // Arriving here means we have hit a singleton sign character + unsigned char sign_char; if( is_negative ) { sign_char = ascii_minus; } else { - if( ch == ascii_plus ) + if( ch == ascii_minus ) { - sign_char = ascii_plus; + sign_char = ascii_space; } else { - sign_char = ascii_space; + sign_char = ascii_plus; } } - dest[i] = sign_char; - if( leftmost_sign == -1 ) - { - leftmost_sign = i; - } - else - { - // This is not the leftmost sign character, so it is where a digit - // goes. - dest[i] = source[index_s++]; - if( leftmost_nonzero == -1 && dest[i] != ascii_zero ) - { - leftmost_nonzero = i; - } - } - rightmost_sign = i+1; + dest[i] = sign_char; break; - } case ascii_comma: case ascii_period: @@ -289,36 +262,6 @@ __gg__string_to_numeric_edited( char * const dest, { decimal_position = i; } - break; - - case ascii_slash: - case ascii_d: - case ascii_D: - case ascii_b: - case ascii_c: - case ascii_C: - case ascii_r: - case ascii_R: - case ascii_0: - // These are left where they are - break; - - case ascii_B: - // This needs some special attention, because a DB at the end is not - // the same as a B on its own at the end. - if( i < length_d-1 ) - { - dest[i] = ascii_space; - } - else if( length_d >= 1 ) - { - if( dest[i-1] != ascii_D && dest[i-1] != ascii_d ) - { - // This is an isolated B at the very end of the string - dest[i] = ascii_space; - } - // Otherwise, that final B is part of a DB, and is left alone. - } break; case ascii_9: @@ -329,175 +272,130 @@ __gg__string_to_numeric_edited( char * const dest, leftmost_nonzero = i; } break; - - case ascii_asterisk: - // These are positions that hold digits - if( leftmost_asterisk == -1 ) - { - leftmost_asterisk = i; - } - rightmost_asterisk = i+1; - - dest[i] = source[index_s++]; - if( dest[i] == ascii_zero ) - { - zeroed_asterisk += 1; - } - else - { - if( leftmost_nonzero == -1 ) - { - leftmost_nonzero = i; - } - } - break; - - case ascii_Z: - // These are positions that hold digits - if( leftmost_z == -1 ) - { - leftmost_z = i; - } - rightmost_z = i+1; - - dest[i] = source[index_s++]; - if( dest[i] == ascii_zero ) - { - zeroed_z += 1; - } - else - { - if( leftmost_nonzero == -1 ) - { - leftmost_nonzero = i; - } - } - break; - - default: - abort(); } } // Do currency replacement - if( leftmost_currency >= 0 ) + if( floating_char == currency_char ) { - if( leftmost_currency == rightmost_currency-1 ) + // This is a floating currency symbol. We need to start at + // leftmost_float, and walk to the lesser of rightmost_float and + // leftmost_nonzero. We blank every character we encounter until we + // reach the first non-zero character. + int left = leftmost_float; + int right; + if( leftmost_nonzero >= 0 ) { - // This is a solo currency symbol - memcpy(dest + leftmost_currency - (strlen(currency_text)-1), - currency_text, - strlen(currency_text)); + right = std::min(leftmost_nonzero, rightmost_float); + if( decimal_position >= 0 ) + { + right = std::min(right, decimal_position); + } } else { - // This is a floating currency symbol. We need to start at - // leftmost_currency, and walk to the lesser of rightmost_currency and - // leftmost_nonzero. We blank every character we encounter. - int left = leftmost_currency; - int right; - if( leftmost_nonzero >= 0 ) - { - right = std::min(leftmost_nonzero, rightmost_currency); - if( decimal_position >= 0 ) - { - right = std::min(right, decimal_position); - } - } - else - { - right = rightmost_currency; - } - // blank out that range - memset(dest+left, ascii_space, right-left); + right = rightmost_float; + } + // blank out that range + assert(right-left < MAX_POSSIBLE && right-left >= 0); + memset(dest+left, ascii_space, right-left); - // To handle situations like PIC $$$,999, where the currency sign has to - // overwrite the comma, we walk from here until we hit the column just to - // the left of a digit - while( right < length_d ) - { + // To handle situations like PIC $$$,999, where the currency sign has to + // overwrite the comma, we walk from here until we hit the column just to + // the left of a digit + while( right < length_d ) + { if( (dest[right] >= ascii_zero && dest[right] <= ascii_nine) - || right == decimal_position ) - { - break; - } - dest[right] = ascii_space; - right += 1; - } - if( right < length_d ) + || right == decimal_position ) { - right -= 1; - memcpy(dest + right - (strlen(currency_text)-1), - currency_text, - strlen(currency_text)); + break; } + dest[right] = ascii_space; + right += 1; + } + if( right < length_d ) + { + right -= 1; + memcpy(dest + right - (strlen(currency_text)-1), + currency_text, + strlen(currency_text)); } } // Do sign replacement - if( leftmost_sign >= 0 ) + if( floating_char == ascii_plus || floating_char == ascii_minus ) { - if( leftmost_sign == rightmost_sign-1 ) + // This is a floating sign symbol. We need to start at + // leftmost_float, and walk to the lesser of rightmost_float and + // leftmost_nonzero. We blank every character we encounter. + unsigned char sign_char; + if( is_negative ) { - // This is a solo sign symbol - dest[leftmost_sign] = sign_char; + sign_char = ascii_minus; } else { - // This is a floating sign symbol. We need to start at - // leftmost_sign, and walk to the lesser of rightmost_sign and - // leftmost_nonzero. We blank every character we encounter. - int left = leftmost_sign; - int right; - if( leftmost_nonzero >= 0 ) + if( floating_char == ascii_minus ) { - right = std::min(leftmost_nonzero, rightmost_sign); - if( decimal_position >= 0 ) - { - right = std::min(right, decimal_position); - } + sign_char = ascii_space; } else { - right = rightmost_sign; + sign_char = ascii_plus; } - // blank out that range - memset(dest+left, ascii_space, right-left); + } - // To handle situations like PIC $$$,999, where the sign char has to - // overwrite the comma, we walk from here until we hit the column just to - // the left of a digit - while( right < length_d ) + int left = leftmost_float; + int right; + if( leftmost_nonzero >= 0 ) + { + right = std::min(leftmost_nonzero, rightmost_float); + if( decimal_position >= 0 ) { - if( (dest[right] >= ascii_zero && dest[right] <= ascii_nine) - || right == decimal_position ) - { - break; - } - dest[right] = ascii_space; - right += 1; + right = std::min(right, decimal_position); } - if( right < length_d ) + } + else + { + right = rightmost_float; + } + // blank out that range + assert(right-left < MAX_POSSIBLE && right-left >= 0); + memset(dest+left, ascii_space, right-left); + + // To handle situations like PIC $$$,999, where the sign char has to + // overwrite the comma, we walk from here until we hit the column just to + // the left of a digit + while( right < length_d ) + { + if( (dest[right] >= ascii_zero && dest[right] <= ascii_nine) + || right == decimal_position ) { - right -= 1; - dest[right] = sign_char; + break; } + dest[right] = ascii_space; + right += 1; + } + if( right < length_d ) + { + right -= 1; + dest[right] = sign_char; } } // Do '*' zero suppression - if( leftmost_asterisk >= 0 ) + if( floating_char == ascii_asterisk ) { - // This is a floating zero suppression. + // This is a floating zero suppression. - int left = leftmost_asterisk; + int left = leftmost_float; int right; if( leftmost_nonzero >= 0 ) { // The value being formatted is non-zero, so make sure 'right' is no more // than the decimal position. - right = std::min(leftmost_nonzero, rightmost_asterisk); - if( decimal_position >= 0 && decimal_position > leftmost_asterisk ) + right = std::min(leftmost_nonzero, rightmost_float); + if( decimal_position >= 0 && decimal_position > leftmost_float ) { right = std::min(right, decimal_position); } @@ -505,19 +403,19 @@ __gg__string_to_numeric_edited( char * const dest, else { // The value being formatted is zero - if( zeroed_asterisk == length_s ) + if( leftmost_nonzero == -1 && !got_nines ) { - // Every numeric position was a zero on asterisk, so the whole thing - // is starred. + // Every numeric position was a zero, and there were no explicit nines left = 0; right = length_d; } else { - right = rightmost_asterisk; + right = rightmost_float; } } - // blank out that range + // Fill that range with stars + assert(right-left < MAX_POSSIBLE && right-left >= 0); memset(dest+left, ascii_asterisk, right-left); // To handle situations like PIC ZZZ,999, where the suppression char has to @@ -526,7 +424,7 @@ __gg__string_to_numeric_edited( char * const dest, while( right < length_d ) { if( (dest[right] >= ascii_zero && dest[right] <= ascii_nine) - || right == decimal_position ) + || right == decimal_position ) { break; } @@ -543,37 +441,38 @@ __gg__string_to_numeric_edited( char * const dest, } // Do 'Z' zero suppression - if( leftmost_z >= 0 ) + if( floating_char == ascii_Z ) { - // This is a floating zero suppression. + // This is a floating zero suppression. - int left = leftmost_z; + int left = leftmost_float; int right; if( leftmost_nonzero >= 0 ) { // The value being formatted is non-zero, so make sure 'right' is no more // than the decimal position. - right = std::min(leftmost_nonzero, rightmost_z); - if( decimal_position >= 0 && decimal_position > leftmost_asterisk ) + right = std::min(leftmost_nonzero, rightmost_float); + if( decimal_position >= 0 && decimal_position > leftmost_float ) { right = std::min(right, decimal_position); } } else { - if( zeroed_z == length_s ) + if( leftmost_nonzero == -1 && !got_nines ) { - // Every numeric position was a zero on asterisk, so the whole thing + // Every numeric position was a zero on 'Z', so the whole thing // is blanked. left = 0; right = length_d; } else { - right = rightmost_z; + right = rightmost_float; } } // blank out that range + assert(right-left < MAX_POSSIBLE && right-left >= 0); memset(dest+left, ascii_space, right-left); // To handle situations like PIC ZZZ,999, where the suppression char has to @@ -582,7 +481,7 @@ __gg__string_to_numeric_edited( char * const dest, while( right < length_d ) { if( (dest[right] >= ascii_zero && dest[right] <= ascii_nine) - || right == decimal_position ) + || right == decimal_position ) { break; } @@ -591,10 +490,11 @@ __gg__string_to_numeric_edited( char * const dest, } } - // Any final DB/CR needs to be addressed: - if( !is_negative - && length_d >= 2 - && ( dest[length_d-2] == ascii_D + // Any final DB/CR needs to be addressed. If the number is positive, or + // all the digits were zeroes, then blank any CR/DB at the end: + if( (!is_negative || leftmost_nonzero < 0) + && length_d >= 2 + && ( dest[length_d-2] == ascii_D || dest[length_d-2] == ascii_d || dest[length_d-2] == ascii_C || dest[length_d-2] == ascii_c ) ) diff --git a/libgcobol/valconv.h b/libgcobol/valconv.h index 62ee342c2b0b..cbd2a2194f5c 100644 --- a/libgcobol/valconv.h +++ b/libgcobol/valconv.h @@ -55,7 +55,6 @@ extern "C" int high_char ); void __gg__string_to_numeric_edited(char * const dest, const char *source, // ASCII - int rdigits, int is_negative, const char *picture); void __gg__string_to_alpha_edited(char *dest,
