From: Robert Dubner <[email protected]> Date: Mon, 28 Sep 2026 09:16:56 -0400 Subject: [PATCH] cobol: Validate numeric-edited PICTURE. Correct numeric-edited handling.
There are two sets of related changes here. They both improve processing numeric-edited variables. One set does exhaustive checking of numeric-edited PICTURE strings, and generates appropriate error messages when they are incorrect. The other set brings MOVE numeric-display to numeric-edited, and comparisons of numeric-display and numeric-edited variables into accordance with the ISO specifications. Co-authored-by: James K. Lowden <[email protected]> Co-authored-by: Robert Dubner <[email protected]> gcc/cobol/ChangeLog: * compare.cc (numeric_alpha_compare): Numeric-edited handling. * genapi.cc (parser_setop): Likewise. * genapi.h (parser_setop): Likewise. * parse.y: Likewise. * picture.cc (class picture_t): Validate PICTURE. (is_valid_picture): Likewise. (process_file): Likewise. (main): Formatting * scan_ante.h (level_needed): Likewise. (class enter_leave_t): Likewise. (trim_location): Likewise. (binary_integer_usage): Likewise. (level_of): Likewise. (ndigit): Likewise. (symbol_exists): Likewise. (typed_name): Likewise. (yyunput): Likewise. (unquote): Likewise. * symbols.cc (symbols_update): Likewise. (struct symbol_elem_t): Likewise. (symbol_file): Likewise. (expand_picture): Numeric-edited handling. (expand_expanded): Likewise. (cbl_file_t::filename_of): Formatting. libgcobol/ChangeLog: * libgcobol.cc (format_for_display_internal): Numeric-edited handling. (__gg__move): Likewise. (__gg__compare_numdisp_alpha): Likewise. gcc/testsuite/ChangeLog: * cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITIALIZE_Without_-f defaultbyte___ASCII_.out: Modified for updated numeric-edited handling. * cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITIALIZE_Without_-f defaultbyte___EBCDIC_.out: Likewise. * cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob: Likewise. * cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out: Likewise. * cobol.dg/group2/REDEFINES__chained.out: Likewise. --- gcc/cobol/compare.cc | 26 ++ gcc/cobol/genapi.cc | 35 +-- gcc/cobol/genapi.h | 4 +- gcc/cobol/parse.y | 11 +- gcc/cobol/picture.cc | 161 +++++------ gcc/cobol/scan_ante.h | 99 ++++--- gcc/cobol/symbols.cc | 49 ++-- ...TIALIZE_Without_-fdefaultbyte___ASCII_.out | 6 +- ...IALIZE_Without_-fdefaultbyte___EBCDIC_.out | 6 +- .../CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob | 2 +- .../CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out | 2 +- .../cobol.dg/group2/REDEFINES__chained.out | 2 +- libgcobol/libgcobol.cc | 259 ++++++++++++++---- 13 files changed, 430 insertions(+), 232 deletions(-) diff --git a/gcc/cobol/compare.cc b/gcc/cobol/compare.cc index eabfe650082..bca2bd6c426 100644 --- a/gcc/cobol/compare.cc +++ b/gcc/cobol/compare.cc @@ -1078,6 +1078,32 @@ numeric_alpha_compare(tree &left, compared = true; } } + + if( !compared ) + { + if( left_side.field->type == FldNumericDisplay ) + { + right = integer_zero_node; + + int flags = left_side.all ? 2: 0 + + right_side.all ? 1: 0 ; + + tree right_offset = gg_cast(SIZE_T, refer_offset(right_side)); + tree length_right = refer_size_source(right_side); + tree left_offset = gg_cast(SIZE_T, refer_offset(left_side)); + left = gg_call_expr(INT, + "__gg__compare_numdisp_alpha", + gg_get_address_of(left_side.field->var_decl_node), + left_offset, + gg_get_address_of(right_side.field->var_decl_node), + right_offset, + length_right, + build_int_cst_type(INT, flags), + NULL_TREE); + compared = true; + } + } + if( !compared ) { // The left side is a fixed-point numeric of some kind. First, we pick diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 62a8ea918db..acedc4a7250 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -7573,7 +7573,7 @@ parser_label_goto(struct cbl_label_t *label) void parser_setop( struct cbl_field_t *tgt, - struct cbl_field_t *candidate, + struct cbl_refer_t &candidate, enum setop_t op, struct cbl_field_t *domain) { @@ -7582,7 +7582,7 @@ parser_setop( struct cbl_field_t *tgt, { SHOW_PARSE_HEADER SHOW_PARSE_FIELD(" ", tgt) - SHOW_PARSE_FIELD(" = ", candidate) + SHOW_PARSE_FIELD(" = ", candidate.field) if( op == is_op ) { SHOW_PARSE_TEXT(" is_op ") @@ -7592,13 +7592,13 @@ parser_setop( struct cbl_field_t *tgt, } CHECK_FIELD(tgt); - CHECK_FIELD(candidate); + CHECK_FIELD(candidate.field); CHECK_FIELD(domain); TRACE1 { TRACE1_HEADER - TRACE1_FIELD("parser_setop: ", candidate, "") + TRACE1_REFER("parser_setop: ", candidate, "") TRACE1_TEXT(" ") TRACE1_TEXT(setop_str(op)) TRACE1_FIELD(" ", domain, "") @@ -7610,25 +7610,28 @@ parser_setop( struct cbl_field_t *tgt, switch(op) { case is_op: - switch(candidate->type) + switch(candidate.field->type) { case FldGroup: case FldAlphanumeric: - gg_assign(tgt->var_decl_node, gg_build_relational_expression( - gg_call_expr(INT, - "__gg__setop_compare", - gg_get_address_of(candidate->var_decl_node), - member(domain, "initial"), - NULL_TREE), - ne_op, - integer_zero_node)); + gg_assign(tgt->var_decl_node, + gg_build_relational_expression(gg_call_expr( + INT, + "__gg__setop_compare", + gg_get_address_of(candidate.field->var_decl_node), + refer_offset(candidate), + refer_size_source(candidate), + member(domain, "initial"), + NULL_TREE), + ne_op, + integer_zero_node)); break; default: dbgmsg("%10s in %s:%d", __func__, __FILE__, __LINE__ ); cbl_internal_error("candidate %s has unimplemented %<CVT_type%> %d(%s)", - candidate->name, - candidate->type, - cbl_field_type_str(candidate->type)); + candidate.field->name, + candidate.field->type, + cbl_field_type_str(candidate.field->type)); gcc_unreachable(); break; } diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h index 0f20f4dfd33..6cd8eed07e1 100644 --- a/gcc/cobol/genapi.h +++ b/gcc/cobol/genapi.h @@ -187,7 +187,9 @@ parser_logop( struct cbl_field_t *tgt, void parser_setop( struct cbl_field_t *tgt, - struct cbl_field_t *a, enum setop_t, struct cbl_field_t *b ); + struct cbl_refer_t &candidate, + enum setop_t, + struct cbl_field_t *b ); void parser_bitop( struct cbl_field_t *tgt, diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 500cd0f49b1..25256c516d1 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -4939,7 +4939,11 @@ picture_clause: PIC signed PIC_P[fore] nines } field->set_attr(cbl_field_attr_t($PICTURE.attr)); field->data.apply_picture(*picture.data); - field->blank_initial(picture.data->capacity()); + /* The following odd construction effectively multiplies the + current capacity, which doesn't take stride() into + account, by stride(). */ + field->set_capacity( field->data.capacity()); + field->blank_initial(field->data.capacity()); } | NO_CONDITION { YYERROR; } @@ -6904,13 +6908,13 @@ simple_cond: kind_of_name $$ = new_reference(new_temporary(FldConditional)); // symbol_find does not find FldClass symbols struct symbol_elem_t *e = symbol_field(PROGRAM, 0, $domain); - parser_setop($$->cond(), $1->field, is_op, cbl_field_of(e)); + parser_setop($$->cond(), *$1, is_op, cbl_field_of(e)); } | cexpr NOT CLASS_NAME[domain] { $$ = new_reference(new_temporary(FldConditional)); // symbol_find does not find FldClass symbols struct symbol_elem_t *e = symbol_field(PROGRAM, 0, $domain); - parser_setop($$->cond(), $1->field, is_op, cbl_field_of(e)); + parser_setop($$->cond(), *$1, is_op, cbl_field_of(e)); parser_logop($$->cond(), NULL, not_op, $$->cond()); } | cexpr is OMITTED @@ -15140,6 +15144,7 @@ dialect_words_set( cbl_dialect_t dialect ) { typedef bool (current_tokens_t::*wordop_func_t)(const cbl_loc_t& loc, const cbl_name_t keyword, const cbl_name_t alias); + struct wordop_t { cbl_dialect_t dialect; wordop_func_t op; diff --git a/gcc/cobol/picture.cc b/gcc/cobol/picture.cc index dc988edecaa..e845c46d051 100644 --- a/gcc/cobol/picture.cc +++ b/gcc/cobol/picture.cc @@ -74,11 +74,11 @@ namespace picture_validation { */ enum state_t { invalid_e, - none_e, + none_e, boolean_e, - alphabetic_e, + alphabetic_e, unicode_e, - alphanumeric_e, + alphanumeric_e, alpha_ed_e, national_e, national_ed_e, @@ -129,18 +129,18 @@ namespace picture_validation { /* * The followers table enforces the merest of syntax: in a picture string, * what character may follow another? It reproduces ISO table 10 in - * programmatic form. - * + * programmatic form. + * * "The symbol '+' that appears in a column and in a row by itself, * represents its use in the exponent part of character-string-1 for a - * floating-point numeric-edited item. + * floating-point numeric-edited item. * * The symbols '+' and '-' when used as a non-floating insertion symbol * appear in two columns and two rows. The leftmost column and the uppermost * row for these symbols represent their use as the first symbol in * character-string-1. The rightmost column and the lowermost row for these * symbols represent its use as the last or penultimate symbol in - * character-string-1. + * character-string-1. * * The symbol '+' that appears in a column and in a row by itself, * represents its use in the exponent." @@ -160,7 +160,7 @@ namespace picture_validation { /* B0/ */ { { postdec_e, '/' }, {"" "B0/,.Z*+-$9AXVPNECD"} }, // ante & post /* + */ { { exponent_e, '+' }, {"" "9"} }, /* , */ { { antedec_e, com }, {"" "B0/,.Z*+-$9VPE"} }, - /* . */ { { antedec_e, dot }, {"" "B0/,Z*+-$9E"} }, + /* . */ { { antedec_e, dot }, {"" "B0/,Z*+-$9E"} }, /* . */ { { postdec_e, dot }, {"" "B0/,Z*+-$9E"} }, // ante & post /* +- */ { { antedec_e, '+' }, {"" "B0/,.+-Z*$9VPE"} }, /* +- */ { { antedec_e, '-' }, {"" "B0/,.+-Z*$9VPE"} }, @@ -189,7 +189,7 @@ namespace picture_validation { /* CR/DB */ { { postdec_e, 'C' }, {"" "R"} }, /* CR/DB */ { { postdec_e, 'D' }, {"" "B"} }, }; - + //////////////////////////////////////////////////////////////// struct transition_t { @@ -206,13 +206,13 @@ namespace picture_validation { {} bool operator<(const transition_t& that) const { - if (state == that.state) return ch < that.ch; + if (state == that.state) return ch < that.ch; return state < that.state; } bool operator==(const transition_t& that) const { return match(that); } bool operator!=(const transition_t& that) const { return ! match(that); } - protected: + protected: // match verifies that the row returned by std::lower_bound actually // matches, and isn't the next "bigger" one. bool match(const transition_t& that) const { @@ -220,7 +220,7 @@ namespace picture_validation { && ch == that.ch; } }; - + static std::vector<transition_t> picture_rules { // Alpha and Alphanumeric { none_e, 'A', alphabetic_e }, @@ -233,7 +233,7 @@ namespace picture_validation { { none_e, 'P', antedec_e }, { none_e, 'S', antedec_e }, { none_e, 'V', postdec_e, }, // V before 9 - + { none_e, '1', boolean_e }, { boolean_e, '1', boolean_e }, @@ -267,7 +267,7 @@ namespace picture_validation { { alphanumeric_e, 'B', alpha_ed_e }, { alphanumeric_e, '0', alpha_ed_e }, { alphanumeric_e, '/', alpha_ed_e }, - + // National { national_e, 'N', national_e }, { national_e, '\0', alphanumeric_e }, @@ -292,7 +292,7 @@ namespace picture_validation { { none_e, '-', numeric_ed_e }, { none_e, '+', numeric_ed_e }, { none_e, '$', numeric_ed_e }, - + { antedec_e, '9', antedec_e }, { antedec_e, 'A', alphanumeric_e }, { antedec_e, 'P', numeric_e }, @@ -311,10 +311,10 @@ namespace picture_validation { { antedec_e, '$', numeric_ed_e }, { antedec_e, dot, numeric_ed_e }, { antedec_e, com, numeric_ed_e }, - + { postdec_e, '9', numeric_e }, { postdec_e, 'P', numeric_e }, - + { numeric_e, '9', numeric_e }, { numeric_e, 'P', numeric_e }, { numeric_e, 'V', numeric_e }, @@ -344,7 +344,7 @@ namespace picture_validation { { numeric_ed_e, '*', numeric_ed_e }, { numeric_ed_e, '$', numeric_ed_e }, { numeric_ed_e, 'P', numeric_ed_e }, - { numeric_ed_e, 'V', numeric_ed_e }, // See Table 10 if in doubt. + { numeric_ed_e, 'V', numeric_ed_e }, // See Table 10 if in doubt. { numeric_ed_e, 'C', c_need_r_e }, { numeric_ed_e, 'D', d_need_b_e }, @@ -352,7 +352,7 @@ namespace picture_validation { { c_need_r_e, 'R', numeric_ed_e }, { d_need_b_e, 'B', numeric_ed_e }, }; - + typedef std::array<state_t, 256> automaton_elem_t; typedef std::vector<automaton_elem_t> automaton_matrix_t; @@ -369,8 +369,8 @@ namespace picture_validation { if( matrix[rule.state][ch] ) { nextra++; fprintf(stderr, "%s: redundant rule: #%d { %s '%c' %s }\n", - __func__, i, - state_str(rule.state), rule.ch, + __func__, i, + state_str(rule.state), rule.ch, state_str(rule.next_state)); } #endif @@ -380,7 +380,7 @@ namespace picture_validation { if( nextra ) { cbl_internal_error("%s: %d redundant rules", __func__, nextra); } - + ready = true; return matrix; } @@ -390,8 +390,8 @@ namespace picture_validation { * seen: the preceding character and what characters have appeared that * signify alphanumeric-edited or numeric-edited. */ - static constexpr uint64_t hiword(char ch) { - return (1ULL << (ch - 'A')) << 32; + static constexpr uint64_t hiword(char ch) { + return (1ULL << (ch - 'A')) << 32; } class constraint_t { // Domain of symbols in a picture string. @@ -408,18 +408,18 @@ namespace picture_validation { p_nine = 0x0009, // 9, claim the whole nybble // Bits 0-15: punctuation, currency, and 0, 1, and 9. // Bits 32-58: A-Z - p_A = hiword('A'), - p_B = hiword('B'), - p_C = hiword('C'), - p_D = hiword('D'), - p_E = hiword('E'), - p_N = hiword('N'), - p_P = hiword('P'), - p_S = hiword('S'), - p_U = hiword('U'), - p_V = hiword('V'), - p_X = hiword('X'), - p_Z = hiword('Z'), + p_A = hiword('A'), + p_B = hiword('B'), + p_C = hiword('C'), + p_D = hiword('D'), + p_E = hiword('E'), + p_N = hiword('N'), + p_P = hiword('P'), + p_S = hiword('S'), + p_U = hiword('U'), + p_V = hiword('V'), + p_X = hiword('X'), + p_Z = hiword('Z'), p_alphanumeric_e = (p_A | p_X | p_nine), p_b_0_slash_e = (p_B | p_zero | p_slash), @@ -427,8 +427,8 @@ namespace picture_validation { p_national_ed_e = (p_N | p_b_0_slash_e), p_numeric_e = (p_nine | p_P | p_S | p_V), // B P V Z 9 0 / , . + - CR DB * cs (CR/DB not in mask because at end) - p_numeric_ed2_e = (p_b_0_slash_e | p_comma | p_dot | p_plus | p_minus), - p_numeric_ed_e = ( p_P | p_V | p_Z | p_nine | p_b_0_slash_e | + p_numeric_ed2_e = (p_b_0_slash_e | p_comma | p_dot | p_plus | p_minus), + p_numeric_ed_e = ( p_P | p_V | p_Z | p_nine | p_b_0_slash_e | p_comma | p_dot | p_plus | p_minus | p_star | p_cs), }; uint64_t symbol_mask; @@ -442,7 +442,7 @@ namespace picture_validation { } /* - * 13.18.40.3 Syntax rules FORMAT 1 + * 13.18.40.3 Syntax rules FORMAT 1 */ bool is_allowed( char ch ) const { switch( ch ) { @@ -471,7 +471,7 @@ namespace picture_validation { bool is_boolean() const { return symbol_mask == p_one; } bool is_alphabetic() const { return symbol_mask == p_A; } bool is_national() const { return symbol_mask == p_N; } - + bool is_alphanumeric() const { auto bits = symbol_mask & p_alphanumeric_e; return 0 < bits && symbol_mask == bits; @@ -572,7 +572,7 @@ namespace picture_validation { } return true; } - + cbl_loc_t loc; char prior_ch; const char decimal_point; @@ -590,7 +590,7 @@ namespace picture_validation { // 13.18.40.3 Syntax rules #27 No more than 1 of certain character // sequences. This function misinterprets the rule. The rule is not that // e.g. $$,$$ is invalid. the rule is that the list items are mutually - // exclusive, $$Z is invalid. Keeping the structure for now in case needed. + // exclusive, $$Z is invalid. Keeping the structure for now in case needed. #if 0 bool contiguous_ok(char ch) const { int n = 0; @@ -624,7 +624,7 @@ namespace picture_validation { } return true; // contiguous_ok(ch); } - + public: const char *bad_repeat; @@ -639,7 +639,7 @@ namespace picture_validation { , bad_repeat(nullptr) { // Trim trailing punctuation from picture for later revalidation, because - // we do. + // we do. auto pic = xstrdup(picture); auto pend = pic + strlen(pic); if( pic < --pend ) { @@ -655,7 +655,7 @@ namespace picture_validation { bool append( char ch, size_t len ) { if( prior_ch == '\0' ) { switch(ch) { - case 'S': case '+': case '-': + case 'S': case '+': case '-': field_attr |= signable_e; } } @@ -666,7 +666,7 @@ namespace picture_validation { picsym_set(ch); // emits message about invalid combinations if( ! is_allowed(ch) ) { return false; } - + prior_ch = ch; add_capacity(len? len : 1); observe_the_dot(ch); @@ -675,7 +675,7 @@ namespace picture_validation { } inline void move_caret( int n ) { loc += n; } bool has_s_star() const { return both(p_S, p_star); } - + void extra_dot( size_t pos ) { if( field_data.picture[pos] != '\0') { assert(field_data.picture[pos+1] == '\0'); @@ -693,12 +693,12 @@ namespace picture_validation { case 'U': case 'Z': case '*': case 'B': case '0': // B and 0 but not slash - case '$': case '+': case '-': + case '$': case '+': case '-': return true; } return false; } - + char prior() const { return prior_ch; } cbl_field_data_t data() const { return field_data; } uint64_t attr() const { return field_attr; } @@ -720,7 +720,7 @@ namespace picture_validation { void maybe_signable( char ch ) { switch(TOUPPER(ch)) { - case '+': case '-': + case '+': case '-': field_attr |= signable_e; } dbgmsg("%s: '%c', %ssignable", __func__, @@ -736,7 +736,7 @@ namespace picture_validation { break; } } - + /* * The followers table is sensitive to whether we've seen decimal point, and * whether we're in an exponent. That reflects the duplicate column @@ -745,14 +745,14 @@ namespace picture_validation { bool day_follows_night( char ch ) const { const static std::string domain("*+,-./019ABENPSVXZCRDB"); return std::string::npos != domain.find(ch); - + auto p = followers.find( follow_key_t {pic_state, prior_ch} ); if( p != followers.end() ) { const auto& candidates(p->second); auto pnext = std::find( candidates.begin(), candidates.end(), ch ); return pnext != candidates.end(); } - return false; + return false; } inline bool first_dollar( char ch ) { return ch == '$' && ndollar == 0; } @@ -765,27 +765,30 @@ namespace picture_validation { * + (count of $ minus 1) + (count of - minus one) + (count of + minus 1) * 3) data.rdigits is the subset of 2 that is to the right of either V or * . (edited) - * - * For the moment, break out the fact that V should add zero. Right now - * all of the regression tests assume that V, if there, adds one. I would - * really rather attack the V change when everything is working. */ void add_capacity(int n) { - static const std::string nonsize( "P" ); // do not exclude V from capacity for now - if( prior_ch == 'P' ) { + switch( prior_ch ) { + case 'V': + n = 0; // only in debug message + break; + case 'P': np += n; field_attr |= scaled_e; // P in front has positive rdigit less one; P aft is negative rdigit. - int ndigit = only(p_P | p_S)? (1 < np? n : n - 1) : -n; - field_data.rdigits += ndigit; - } else { + { + int ndigit = only(p_P | p_S)? (1 < np? n : n - 1) : -n; + field_data.rdigits += ndigit; + } + n = 0; // only in debug message + break; + default: field_data.add_capacity(n); if( digital() ) { - field_data.digits += n; + field_data.digits += n; if( pic_state == postdec_e ) { field_data.rdigits += n; } - } else { n = 0; } // for debug + } } dbgmsg("%s: '%c', added %d: {%u, %u,%d}", __func__, prior_ch, n, field_data.capacity(), field_data.digits, field_data.rdigits); @@ -801,7 +804,7 @@ namespace picture_validation { case '9': case 'Z': case '*': return true; case 'V': - return true; + return false; case '+': return 0 < nplus++; case '-': @@ -860,7 +863,7 @@ class picture_t : public lex_picture_t { { attr = none_e; pos = 0; - blank_when_zero_ok = true; + blank_when_zero_ok = true; type = FldInvalid; encoding = current_encoding('A'); data = new cbl_field_data_t; @@ -926,10 +929,10 @@ class picture_t : public lex_picture_t { } }; -lex_picture_t +lex_picture_t is_valid_picture(const cbl_loc_t& loc, const char picture[]) { picture_validation::constraint_t constraint(loc, picture); - + const picture_validation::automaton_matrix_t& automaton = picture_validation::prepare_automaton(); @@ -944,11 +947,11 @@ is_valid_picture(const cbl_loc_t& loc, const char picture[]) { * If a currency has a symbol, width is set to its length until appended, * then becomes 1. */ - size_t width = 0; + size_t width = 0; for( ; p < epicture; p++, output.pos++ ) { // Advance lookahead past any count, which might be a name. - // No picture begins with a '('. + // No picture begins with a '('. if( *p == '(' && p+1 < epicture ) { if( constraint.repeatable() ) { const char *paren = p; @@ -982,15 +985,15 @@ is_valid_picture(const cbl_loc_t& loc, const char picture[]) { } char ch = TOUPPER(*p); - - // Is the current character ever allowed to follow the prior? + + // Is the current character ever allowed to follow the prior? if( ! constraint.day_follows_night(ch) || constraint.first_dollar(ch)) { const char *currency = symbol_currency(ch); if( currency ) { ch = '$'; width = width == 0? strlen(currency) : 1; } else { - dbgmsg("%s:%d: no %2lu: %c -> %c (%s)\n", __func__, __LINE__, + dbgmsg("%s:%d: no %2lu: %c -> %c (%s)\n", __func__, __LINE__, (unsigned long)(p - picture), constraint.prior(), ch, picture_validation::state_str(constraint.picture_state())); return output; @@ -1009,8 +1012,8 @@ is_valid_picture(const cbl_loc_t& loc, const char picture[]) { constraint.maybe_signable(state); } else { state = picture_validation::invalid_e; - } - + } + if( state == picture_validation::invalid_e ) { dbgmsg("%s:%d: automaton has no transition for %s '%c'", __func__, __LINE__, old_state, ch); @@ -1067,12 +1070,12 @@ process_file(const char* filename) { return false; } } - + char *picture = nullptr; size_t plen = 0; ssize_t len; int lineno = 0; - + while( (len = getline(&picture, &plen, input)) != -1 ) { auto p = std::find(picture, picture + len, '\n'); if( p < picture + len ) *p = '\0'; @@ -1084,7 +1087,7 @@ process_file(const char* filename) { int main(int argc, char* argv[]) { int opt; - bool fOK; + bool fOK; const char *picture = nullptr; while ((opt = getopt(argc, argv, "p:v")) != -1) { @@ -1109,7 +1112,7 @@ main(int argc, char* argv[]) { fOK = process_file(nullptr); } } - + return fOK ? 0 : 1; } diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index 99387eae60c..00ea991cbd3 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -353,8 +353,8 @@ static bool level_needed() { /* * Return all but the first N characters, to be rescanned by the nexst yylex. - * IOW, keep N characters as the token, and relinquish the rest. - * Must be a macro because it expands yyless. + * IOW, keep N characters as the token, and relinquish the rest. + * Must be a macro because it expands yyless. */ #define myless(N) \ do { \ @@ -425,11 +425,11 @@ class enter_leave_t { /* * The lexer knows the immediate status of the input file and its line number * from the PUSH, POP, and LINE directives. It saves yylineno whenever it - * encounters a PUSH, and updates it for a POP. + * encounters a PUSH, and updates it for a POP. * * The line number trickles into the parser by way of location. Only the * parser knows what token it is parsing. As for the filename, the lexer - * queues enter/leave notices for the parser. + * queues enter/leave notices for the parser. * * Whenever the parser fetches a token, it gets the current line number from * yylineno, and the current filename by depleting the notification queue, if @@ -532,8 +532,8 @@ trim_location( int nkeep) { yylloc.last_column = 1 + (eokeep - nl); } - gcc_assert( yylloc.first_line <= yylloc.last_line ); - gcc_assert( 0 < yylloc.last_column ); + gcc_assert( yylloc.first_line <= yylloc.last_line ); + gcc_assert( 0 < yylloc.last_column ); ////location_dump(__func__, __LINE__, "yylloc", yylloc, true); } @@ -591,7 +591,7 @@ static char *tmpstring = NULL; // map of alias => canonical static std::map <std::string, std::string> keyword_aliases; -std::pair<std::string, bool> +std::pair<std::string, bool> keyword_alias_add( const std::string& keyword, const std::string& alias ) { auto elem = std::make_pair(alias, keyword); auto result = keyword_aliases.insert(elem); @@ -610,37 +610,37 @@ struct bint_t { bool signable; }; static const std::map <std::string, bint_t > binary_integers { - { "BINARY", { COMPUTATIONAL, FldNumericBinary, 0, false } }, - { "COMP", { COMPUTATIONAL, FldNumericBinary, 0, false } }, - { "COMPUTATIONAL", { COMPUTATIONAL, FldNumericBinary, 0, false } }, - { "COMP-4", { COMPUTATIONAL, FldNumericBinary, 0, false } }, - { "COMPUTATIONAL-4", { COMPUTATIONAL, FldNumericBinary, 0, false } }, - - { "BINARY-CHAR", { _BINARY_INTEGER, FldNumericBin5, 1, true } }, - { "BINARY-SHORT", { _BINARY_INTEGER, FldNumericBin5, 2, true } }, - { "BINARY-LONG", { _BINARY_INTEGER, FldNumericBin5, 4, true } }, - { "BINARY-DOUBLE", { _BINARY_INTEGER, FldNumericBin5, 8, true } }, - { "BINARY-LONG-LONG", { _BINARY_INTEGER, FldNumericBin5, 8, true } }, - - { "COMP-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, - { "COMPUTATIONAL-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, - { "COMP-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, - { "COMPUTATIONAL-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, - - { "COMP-1", { COMPUTATIONAL, FldFloat, 4, false } }, - { "COMPUTATIONAL-1", { COMPUTATIONAL, FldFloat, 4, false } }, - { "FLOAT-BINARY-32", { COMPUTATIONAL, FldFloat, 4, false } }, - { "FLOAT-SHORT", { COMPUTATIONAL, FldFloat, 4, false } }, - - { "COMP-2", { COMPUTATIONAL, FldFloat, 8, false } }, - { "COMPUTATIONAL-2", { COMPUTATIONAL, FldFloat, 8, false } }, - { "FLOAT-BINARY-64", { COMPUTATIONAL, FldFloat, 8, false } }, - { "FLOAT-LONG", { COMPUTATIONAL, FldFloat, 8, false } }, - { "FLOAT-BINARY-128", { COMPUTATIONAL, FldFloat, 16, false } }, - { "FLOAT-EXTENDED", { COMPUTATIONAL, FldFloat, 16, false } }, - - { "COMP-6", { COMPUTATIONAL, FldPacked, 0, false } }, - { "COMPUTATIONAL-6", { COMPUTATIONAL, FldPacked, 0, false } }, + { "BINARY", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMP", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMPUTATIONAL", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMP-4", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + { "COMPUTATIONAL-4", { COMPUTATIONAL, FldNumericBinary, 0, false } }, + + { "BINARY-CHAR", { _BINARY_INTEGER, FldNumericBin5, 1, true } }, + { "BINARY-SHORT", { _BINARY_INTEGER, FldNumericBin5, 2, true } }, + { "BINARY-LONG", { _BINARY_INTEGER, FldNumericBin5, 4, true } }, + { "BINARY-DOUBLE", { _BINARY_INTEGER, FldNumericBin5, 8, true } }, + { "BINARY-LONG-LONG", { _BINARY_INTEGER, FldNumericBin5, 8, true } }, + + { "COMP-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, + { "COMPUTATIONAL-5", { COMPUTATIONAL, FldNumericBin5, 0, false } }, + { "COMP-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, + { "COMPUTATIONAL-X", { COMPUTATIONAL, FldNumericBin5, 0xFF, false } }, + + { "COMP-1", { COMPUTATIONAL, FldFloat, 4, false } }, + { "COMPUTATIONAL-1", { COMPUTATIONAL, FldFloat, 4, false } }, + { "FLOAT-BINARY-32", { COMPUTATIONAL, FldFloat, 4, false } }, + { "FLOAT-SHORT", { COMPUTATIONAL, FldFloat, 4, false } }, + + { "COMP-2", { COMPUTATIONAL, FldFloat, 8, false } }, + { "COMPUTATIONAL-2", { COMPUTATIONAL, FldFloat, 8, false } }, + { "FLOAT-BINARY-64", { COMPUTATIONAL, FldFloat, 8, false } }, + { "FLOAT-LONG", { COMPUTATIONAL, FldFloat, 8, false } }, + { "FLOAT-BINARY-128", { COMPUTATIONAL, FldFloat, 16, false } }, + { "FLOAT-EXTENDED", { COMPUTATIONAL, FldFloat, 16, false } }, + + { "COMP-6", { COMPUTATIONAL, FldPacked, 0, false } }, + { "COMPUTATIONAL-6", { COMPUTATIONAL, FldPacked, 0, false } }, }; static int @@ -657,10 +657,10 @@ binary_integer_usage( const char name[]) { std::string key = uname; auto alias = keyword_aliases.find(key); if( alias != keyword_aliases.end() ) key = alias->second; - + auto p = binary_integers.find(key); if( p == binary_integers.end() ) return 0; - + yylval.computational.type = p->second.type; yylval.computational.capacity = p->second.capacity; yylval.computational.signable = p->second.signable; @@ -669,7 +669,7 @@ binary_integer_usage( const char name[]) { free(uname); return p->second.token; } - + static void verify_ws( char ch ) { if( ! fisspace(ch) ) { @@ -712,7 +712,7 @@ level_of( const char input[] ) { /* * Input may have leading or trailing V, which is ignored. - * Return the decoded picture size insofar as possible. + * Return the decoded picture size insofar as possible. * If the picture switches from 9s to Ps, say, set pleft to the remainder. */ static int @@ -721,7 +721,7 @@ ndigit(int len, const char **pleft = nullptr) { if( TOUPPER(p[0]) == 'V' ) p++; if( p == pend ) return 0; // Only the V int n = 0; - + for( char model = *p; p < pend; p++ ) { assert(*p == model); n++; @@ -729,7 +729,7 @@ ndigit(int len, const char **pleft = nullptr) { std::pair<uint32_t, int> result = repeat_count(p); int count = result.first, pos = result.second; - + if( pos == -1 ) { if( pleft ) *pleft = ++p; // because *p at least was ok, per assertion. break; @@ -804,7 +804,7 @@ symbol_exists( const char name[] ) { /* * Before data division has been defined and the cache populated, or if the * map search failes, search the symbol table in case of named literal. - */ + */ symbol_elem_t *e = symbol_field( PROGRAM, 0, name ); return e; } @@ -817,8 +817,8 @@ typed_name( const char name[] ) { int token = repository_function_tok(name); switch(token) { case 0: - if(false) // we don't know how to do this yet. - { // Functions in the symbol table may be used without the FUNCTION keyword. + if(false) // we don't know how to do this yet. + { // Functions in the symbol table may be used without the FUNCTION keyword. cbl_label_t *L = symbol_function_any(0, name); if( L ) { auto args = prototype_args(L->name); @@ -952,7 +952,7 @@ static void yyunput(int ch, char yytext_ptr[]); static int continue_string( char quote ) { int ch; - + for( ; (ch = yyinput()) != quote; yylloc.last_column++ ) { switch(ch) { case EOF: case 0: return ch; @@ -1077,7 +1077,7 @@ unquote() { char *output = xstrdup(yytext), quote = *p; char prior = '\0'; - pend = std::copy_if( ++p, --pend, output, + pend = std::copy_if( ++p, --pend, output, [quote, &prior]( char ch ) { if( ch == quote ) { if( ch == prior ) { @@ -1091,4 +1091,3 @@ unquote() { *pend = '\0'; return output; } - diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index db64208fabf..9dc547dc24c 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -1907,7 +1907,7 @@ symbols_update( size_t first, bool parsed_ok ) { if( !field->is_valid() ) { size_t isym = p - symbols_begin(); - symbols_dump(symbols.first_program, true); + symbols_dump(symbols.first_program + 18, true); if( symbol_at(field->parent)->type == SymFile ) { assert(field->parent == field_index(field) + 1); auto e = std::find_if( symbols_begin(field->parent), symbols_end(), @@ -2081,7 +2081,7 @@ symbols_update( size_t first, bool parsed_ok ) { } if( parsed_ok ) { parser_file_add(&file); - update_symbol_map2(file); // Add FD name as a name for the default record. + update_symbol_map2(file); // Add FD name as a name for the default record. } } else { if( p->type == SymField ) { @@ -3086,7 +3086,7 @@ struct symbol_elem_t * symbol_file( size_t program, const char name[] ) { auto key( elem_key_t(program, name) ); auto p = symbols.files.find(key); - + if( p == symbols.files.end() ) { // Look for global FD in containing program. while( key.program ) { key.program = symbol_at(key.program)->program; @@ -3105,7 +3105,7 @@ symbol_file( size_t program, const char name[] ) { name, (unsigned long)p->second); auto e = symbol_at(p->second); return e; - } + } dbgmsg("%s:%d: not found: %s", __func__, __LINE__, name); return nullptr; @@ -3700,7 +3700,7 @@ static class program_temporaries_t : private symbol_temporaries_t { alphas.clear(); } } program_temporaries; - + /* * Supply a reference to the current list of temporaries for use by codegen to free * the memory if it decides to return to the caller. @@ -4853,7 +4853,7 @@ expand_picture(const char *picture) if( currency_symbol ) { size_t sign_length = __gg__currency_signs[currency_symbol].size(); - assert(0 < sign_length); + assert(0 < sign_length); if( --sign_length ) { char *pcurrency = strchr(retval, currency_symbol); @@ -4870,6 +4870,9 @@ expand_picture(const char *picture) } retval[dest_length] = NULLCH; + // The 'V' + + // To ease the workload on interpreting the PICTURE string at run time, we // are going to convert everything we can to upper case. We also convert // V to decimal point, for the same reason. Characters that might be @@ -4886,18 +4889,15 @@ expand_picture(const char *picture) case ascii_s: case ascii_x: case ascii_z: - retval[i] = TOUPPER(retval[i]); - break; - case ascii_V: case ascii_v: - retval[i] = __gg__decimal_point; + retval[i] = TOUPPER(retval[i]); break; // We need special processing for DB. When they appear as the final two // characters, they are the accounting sign "DB" indicator and we have to - // leave the case as the programmer established it. Otherwise we have to + // leave the case as the programmer established it. Otherwise we have to // make the 'B' uppercase. - + case ascii_B: case ascii_b: if( i < dest_length-1 ) @@ -4915,6 +4915,13 @@ expand_picture(const char *picture) } } + // The V character is virtual in numeric_editing, so get rid of it + char *pV = strchr(retval, ascii_V); + if( pV ) + { + memmove(pV, pV+1, strlen(pV)); + } + // AD HOC FIX for an improper trailing space char *pspace = strchr(retval, ascii_space); if( pspace ) @@ -4938,23 +4945,23 @@ expand_expanded(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. - + 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. @@ -4962,7 +4969,7 @@ expand_expanded(char *expanded) 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); @@ -5804,7 +5811,7 @@ cbl_file_t::filename_of() const { if( filename != 0 ) { return cbl_field_of(symbol_at(filename))->name; } if( device != 0 ) { auto dev = cbl_special_name_of(symbol_at(device)); - if( dev->os_filename[0] != '\0' ) return dev->os_filename; + if( dev->os_filename[0] != '\0' ) return dev->os_filename; } return nullptr; } diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___ASCII_.out b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___ASCII_.out index 1cf642bf915..0c30f30451c 100644 --- a/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___ASCII_.out +++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___ASCII_.out @@ -1,6 +1,6 @@ allocate characters INITIALIZED (ISO 2023 Rule 6: defaultbyte if specified, else zero) (1) as allocated - "" "000" 0x0000000000000000 + "" "" 0x0000000000000000 (2) after "initialize based-var" " " "000" 0x0000000000000000 (3) after "initialize based-var all to value" @@ -14,14 +14,14 @@ allocate based-var initialized (ISO 2023 Rule 7: ALL TO VALUE) "I am I, Don Quixote " "123" 0x0000000000000000 allocate characters (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero) (1) as allocated - "" "000" 0x0000000000000000 + "" "" 0x0000000000000000 (2) after "initialize based-var" " " "000" 0x0000000000000000 (3) after "initialize based-var all to value" "I am I, Don Quixote " "123" 0x0000000000000000 allocate based-var (ISO 2023 Rule 9: pointers NULL, otherwise OPT_INIT) (1) as allocated - "" "000" 0x0000000000000000 + "" "" 0x0000000000000000 (2) after "initialize based-var" " " "000" 0x0000000000000000 (3) after "initialize based-var all to value" diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___EBCDIC_.out b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___EBCDIC_.out index 1cf642bf915..0c30f30451c 100644 --- a/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___EBCDIC_.out +++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rules_6_-_9._Without_OPTION_INITI ALIZE_Without_-fdefaultbyte___EBCDIC_.out @@ -1,6 +1,6 @@ allocate characters INITIALIZED (ISO 2023 Rule 6: defaultbyte if specified, else zero) (1) as allocated - "" "000" 0x0000000000000000 + "" "" 0x0000000000000000 (2) after "initialize based-var" " " "000" 0x0000000000000000 (3) after "initialize based-var all to value" @@ -14,14 +14,14 @@ allocate based-var initialized (ISO 2023 Rule 7: ALL TO VALUE) "I am I, Don Quixote " "123" 0x0000000000000000 allocate characters (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero) (1) as allocated - "" "000" 0x0000000000000000 + "" "" 0x0000000000000000 (2) after "initialize based-var" " " "000" 0x0000000000000000 (3) after "initialize based-var all to value" "I am I, Don Quixote " "123" 0x0000000000000000 allocate based-var (ISO 2023 Rule 9: pointers NULL, otherwise OPT_INIT) (1) as allocated - "" "000" 0x0000000000000000 + "" "" 0x0000000000000000 (2) after "initialize based-var" " " "000" 0x0000000000000000 (3) after "initialize based-var all to value" diff --git a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob index 6c742266f39..e6eb052e0ec 100644 --- a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob +++ b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob @@ -14,7 +14,7 @@ DATA DIVISION. WORKING-STORAGE SECTION. 77 euro-val pic 99v99. - 77 EUROS PIC @99v99. + 77 EUROS PIC @99.99. 77 cents PIC 9,999&. 77 DOLLARS Pic $$,$$9.99. diff --git a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out index 3618adb6b0d..861e65a2826 100644 --- a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out +++ b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out @@ -1,4 +1,4 @@ -#EUR 01.23# equal #1,234 ct (EUR)# +#EUR 12.34# equal #1,234 ct (EUR)# Invoice amount #1 is $US1,500.00. Invoice amount #2 is $US12.34. diff --git a/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.out b/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.out index 56f7d295638..ce2b80c666e 100644 --- a/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.out +++ b/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.out @@ -1,6 +1,6 @@ "123456789" "6789" -"123456780" +"12345678X" "12345678X" "X" diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index fec2198ea0f..2d2100de2cf 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -2617,6 +2617,8 @@ extern "C" int __gg__setop_compare( const cblc_field_t *candidate_field, + size_t candidate_offset, + size_t candidate_size, char *domain) { // This routine is called to compare the characters of 'candidate' @@ -2639,8 +2641,8 @@ __gg__setop_compare( size_t nbytes_converted; const char *candidate = __gg__iconverter(candidate_field->encoding, HOST_32_ENCODING, - candidate_field->data, - candidate_field->capacity, + candidate_field->data+candidate_offset, + candidate_size, &nbytes_converted); const char *candidate_end = candidate + nbytes_converted; while(candidate < candidate_end) @@ -3364,7 +3366,6 @@ format_for_display_internal(char **dest, + (var->attr & leading_e ? 1 : 0); unsigned char *signloc; unsigned char *digits; - const unsigned char *digits_r = nullptr; // This is the running index into our output destination. int index = 0; bool is_negative=false; @@ -3378,7 +3379,6 @@ format_for_display_internal(char **dest, // not signable signloc = converted; digits = converted; - digits_r = converted + outlength; is_negative = false; break; case 4: @@ -3386,7 +3386,6 @@ format_for_display_internal(char **dest, // internal trailing signloc = converted + outlength-1; digits = converted; - digits_r = converted + outlength; /* In ascii, negative is indicated by turning bit 0x40 on. In ebcdic, by turning bit 0x20 off. In both cases, the result is outside of the range '0' through '9'. Working this way is @@ -3474,7 +3473,6 @@ format_for_display_internal(char **dest, // internal leading signloc = converted; digits = converted; - digits_r = converted + outlength; const charmap_t *charmap_src = __gg__get_charmap(var->encoding); if( charmap_src->is_like_ebcdic() ) { @@ -3555,7 +3553,6 @@ format_for_display_internal(char **dest, // separate trailing signloc = converted + outlength-1; digits = converted; - digits_r = converted + outlength-1; switch(*signloc) { case ascii_plus: @@ -3578,7 +3575,6 @@ format_for_display_internal(char **dest, // separate leading signloc = converted; digits = converted+1; - digits_r = converted + outlength; is_negative = *signloc == ascii_minus; switch(*signloc) { @@ -3598,21 +3594,9 @@ format_for_display_internal(char **dest, break; } } - // We have the sign sorted out; make sure that the digits are valid: - unsigned char *running_location = digits; - while(running_location < digits_r) - { - if( *running_location < ascii_0 || *running_location > ascii_9 ) - { - // An invalid digit becomes '0', and the value is flagged positive - *running_location = ascii_0; - is_negative = false; - } - running_location += 1; - } - // converted[] is now full of valid digits, and is_negative has been - // established. + // is_negative has been established. Everything but the sign byte is + // shown verbatim. switch(signtype) { @@ -3637,7 +3621,7 @@ format_for_display_internal(char **dest, (*dest)[index++] = is_negative ? ascii_minus : ascii_plus; break; } - running_location = digits; + const unsigned char *running_location = digits; // copy over the characters to the left of the decimal point: for(int i=0; i<ldigits; i++ ) @@ -6423,33 +6407,157 @@ __gg__move( cblc_field_t *fdest, } else { - // We are moving a integer NumericDisplay to an - // alphanumeric. We ignore any sign bit, and just - // move the characters: - - size_t source_digits - = fsource->digits + ( fsource->rdigits < 0 - ? -fsource->rdigits : 0) ; + // We are moving a integer NumericDisplay to an alphanumeric. + // In accordance with the specification, we skip any separate + // sign character. We also turn a sign character into its + // positive form, and then do the move verbatim. + char ach_source[256]; + memcpy(ach_source, fsource->data + source_offset, source_size); + + char *source_p = ach_source; + + charmap_t *charmap_source = __gg__get_charmap(fsource->encoding); + int source_stride = charmap_source->stride(); + cbl_char_t source_zero = + charmap_source->mapped_character(ascii_zero); + + int ssl = (fsource->attr & signable_e ? 4 : 0 ) + + (fsource->attr & separate_e ? 2 : 0 ) + + (fsource->attr & leading_e ? 1 : 0 ); + switch(ssl) + { + case 0: + case 1: + case 2: + case 3: + // not signable + break; + case 4: + { + // signable, internal, trailing. + char *signloc = source_p + source_size - source_stride; + if( charmap_source->is_big_endian() && signloc) + { + signloc += source_stride-1; + } + if( charmap_source->is_like_ebcdic() ) + { + // Turn on the "ebcdic is positive" bit. + *signloc |= 0x20; + } + else + { + // Turn off the "ascii is negative" bit. + *signloc &= ~0x40; + } + break; + } + case 5: + { + // signable, internal, leading. + char *signloc = source_p; + if( charmap_source->is_big_endian() && signloc) + { + signloc += source_stride-1; + } + if( charmap_source->is_like_ebcdic() ) + { + // Turn on the "ebcdic is positive" bit. + *signloc |= 0x20; + } + else + { + // Turn off the "ascii is negative" bit. + *signloc &= ~0x40; + } + break; + } + case 6: + { + // signable, separate, trailing. + char *signloc = source_p + source_size - source_stride; + source_size -= 1; + if( charmap_source->is_big_endian() && signloc) + { + signloc += source_stride-1; + } + if( charmap_source->is_like_ebcdic() ) + { + // Turn on the "ebcdic is positive" bit. + *signloc |= 0x20; + } + else + { + // Turn off the "ascii is negative" bit. + *signloc &= ~0x40; + } + break; + } + case 7: + { + // signable, separate, leading. + char *signloc = source_p; + source_size -= source_stride; + source_p += source_stride; + if( charmap_source->is_big_endian() && signloc) + { + signloc += source_stride-1; + } + if( charmap_source->is_like_ebcdic() ) + { + // Turn on the "ebcdic is positive" bit. + *signloc |= 0x20; + } + else + { + // Turn off the "ascii is negative" bit. + *signloc &= ~0x40; + } + break; + } + } + // source_p, source_size, and signloc (if any) have been + // adjusted. - // Pick up the absolute value of the source - value = __gg__int128_from_qualified_field(fsource, - source_offset, - source_size); - char ach[128]; + if( fsource->attr & scaled_e ) + { + if( fsource->rdigits < 0 ) + { + // We are dealing with 9999PPP. We need to tack zeroes onto + // the end of source_p + charmap_source->memset(source_p+source_size, + source_zero, + -fsource->rdigits * source_stride); + source_size += -fsource->rdigits * source_stride; + } + else + { + // We are dealing with PPP999, and we need to insert zeroes + // at the front of source_p: + memmove(source_p + fsource->rdigits * source_stride, + source_p, + fsource->rdigits * source_stride); + charmap_source->memset(source_p, + source_zero, + fsource->rdigits * source_stride); + source_size += fsource->rdigits * source_stride; + } + } - // Convert it to the full complement of digits available - // from the source...but no more - __gg__binary_to_string_encoded(ach, - source_digits, - value, - fdest->encoding); + // We convert the source to the destination character set + size_t nbytes; + char *converted = __gg__iconverter(fsource->encoding, + fdest->encoding, + source_p, + source_size, + &nbytes); if( !(fdest->attr & rjust_e) ) { - min_length = std::min( source_digits*stride, + min_length = std::min( source_size, dest_size); - memmove(fdest->data + dest_offset, ach, min_length); + memmove(fdest->data + dest_offset, converted, min_length); if( min_length < dest_size ) { // min_length is smaller than dest_length, so we @@ -6464,14 +6572,13 @@ __gg__move( cblc_field_t *fdest, { // Destination is right-justified, so things are // slightly more complex - if( source_digits*stride >= dest_size ) + if( source_size >= dest_size ) { // We need to truncate the source data on the // left: - memmove( - fdest->data + dest_offset, - ach + (source_digits*stride - dest_size), - dest_size ); + memmove(fdest->data + dest_offset, + converted + (source_size - dest_size), + dest_size ); } else { @@ -6479,12 +6586,12 @@ __gg__move( cblc_field_t *fdest, // the right side of the destination, and space-fill // the prefix: memmove(fdest->data - + dest_offset + (dest_size - source_digits*stride), - ach, - source_digits*stride ); + + dest_offset + (dest_size - source_size), + converted, + source_size ); charmap->memset( fdest->data + dest_offset, - charmap->mapped_character(ascii_space), - dest_size - source_digits*stride); + charmap->mapped_character(ascii_space), + dest_size - source_size); } } } @@ -13918,3 +14025,49 @@ __gg__move_stash_release(const unsigned char *stash) move_stashes.depth -= 1; } + +extern "C" +int +__gg__compare_numdisp_alpha( cblc_field_t *left, + size_t left_offset, + cblc_field_t *right, + size_t right_offset, + size_t right_length, + int flags) + { + // 'left' is numdisp. We MOVE it to an alphanumeric of the correct size. + charmap_t *charmap_left = __gg__get_charmap(left->encoding); + size_t left_size = left->capacity; + if( left->attr & separate_e ) + { + left_size -= charmap_left->stride(); + } + + cblc_field_t numdisp = {}; + unsigned char numdisp_data[256]; + + numdisp.type = FldAlphanumeric; + numdisp.encoding = left->encoding; + numdisp.data = numdisp_data, + numdisp.capacity = left_size; + __gg__move( &numdisp, + 0, // Offset + numdisp.capacity, + left, + left_offset, + left->capacity, + 0, + truncation_e ); + + int retval; + retval = __gg__compare(&numdisp, + 0, + numdisp.capacity, + flags & 2 ? REFER_T_MOVE_ALL : 0, + right, + right_offset, + right_length, + flags & 1 ? REFER_T_MOVE_ALL : 0, + 0 ); + return retval; + } -- 2.34.1
