https://gcc.gnu.org/g:50cdeaeb5cf2acbc65ef3860186003a0137e8260
commit r17-4011-g50cdeaeb5cf2acbc65ef3860186003a0137e8260 Author: James K. Lowden <[email protected]> Date: Wed Sep 2 12:05:09 2026 -0400 cobol: Faster lexing and some syntax extensions. Because some 2/3 of the lexer's time was spent scanning the symbol table, significant performance gains were possible. The ramifications were surprising. Add Wredefines-table diagnostic, instead of syntax error. Correct Wcopybook-found diagnostic to report all copybooks used. gcc/cobol/ChangeLog: * cdf-copy.cc (copybook_elem_t::open_file): Correct Wcopybook-found diagnostic. * lexio.cc (cdftext::open_input): Same. (output_segment): New function with defeated tab-expansion. (cdftext::process_file): Use new output_segment function. * parse.y: Support Wredefines-table and EXIT RETURNING. Use diagnostic quotes. * scan.l: Support PIC 9(2)9(3) and PIC 9(name). Remove BLANK_OEOL pattern. * scan_ante.h (repeat_count): Return uninterpreted input. (ndigit): Interpret more than one count. (picset): Accept optional length. (symbol_lower_name): Remove function. (symbol_exists): Use map-supported symbol_find(). (scanner_cache_update): Remove function. (typed_name): Return UDF token, not name, if found. (continue_string): New function for string concatenation. * symbols.cc (symbol_function_impl): Use new symbols.functions map. (symbol_file_add): Add file to symbol-table map. (symbol_file): Remove scan, add search for GLOBAL FD. * symbols.h (symbol_find): Quell diagnostic when called from lexer. (class name_queue_t): Return empty list when queue is empty. * symfind.cc (symbol_match): Accept quell parameter. (symbol_find): Same. (symbol_find_of): Supply quell parameter. * util.cc (cdf_field_add): Use symbol_field_add. (named_constant): New function. (repeat_count): Declare to match new return type. Diff: --- gcc/cobol/cdf-copy.cc | 2 + gcc/cobol/lexio.cc | 28 ++++++++--- gcc/cobol/parse.y | 71 +++++++++++++++++++-------- gcc/cobol/scan.l | 68 +++++++++++++------------- gcc/cobol/scan_ante.h | 131 ++++++++++++++++++++++++-------------------------- gcc/cobol/symbols.cc | 96 ++++++++++++------------------------ gcc/cobol/symbols.h | 9 ++-- gcc/cobol/symfind.cc | 10 ++-- gcc/cobol/util.cc | 56 ++++++++++++++++----- 9 files changed, 261 insertions(+), 210 deletions(-) diff --git a/gcc/cobol/cdf-copy.cc b/gcc/cobol/cdf-copy.cc index 50b1adf63844..02c6240eaa35 100644 --- a/gcc/cobol/cdf-copy.cc +++ b/gcc/cobol/cdf-copy.cc @@ -285,6 +285,8 @@ copybook_elem_t::open_file( const char directory[], bool literally ) { error_msg(source.loc, "recursive copybook: '%s' includes itself", path); (void)! close(fd); fd = -1; + } else { + cbl_message(LexInputN, "opening %qs for input", source.name); } return fd; } diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc index 7a90a01eaac7..398a4cd514e4 100644 --- a/gcc/cobol/lexio.cc +++ b/gcc/cobol/lexio.cc @@ -1608,8 +1608,6 @@ cdftext::open_input( const char filename[] ) { dbgmsg( "could not open '%s': %s", filename, xstrerror(erc) ); } - cbl_message(LexInputN, "opening %s for input", filename); - return fd; } @@ -1869,6 +1867,24 @@ cobol_set_indicator_column( int column ) { dbgmsg("%s: format now %s", __func__, local.description()); } +static inline void +output_segment(const char *beg, const char *end, + std::ostream_iterator<char> ofs ) +{ +#if 1 + std::copy(beg, end, ofs); +#else + // Replace each tab with 8 spaces. + for (auto p = beg; p < end; ++p) { + if (*p == '\t') { + std::generate_n(ofs, 8, [](){ return ' '; }); + continue; + } + *ofs = *p; + } +#endif +} + void cdftext::output_push_directive( const char filename[], std::ostream_iterator<char>& ofs ) @@ -1959,7 +1975,7 @@ cdftext::process_file( filespan_t mfile, int output, copy.mfile = free_form_reference_format( copy.in, source_format ); if( copied.partial_line.size() ) { - std::copy(copied.partial_line.p, copied.partial_line.pend, ofs); + output_segment(copied.partial_line.p, copied.partial_line.pend, ofs); } out.flush(); @@ -1997,14 +2013,14 @@ cdftext::process_file( filespan_t mfile, int output, []( char ch ) { return ch == '\n'; } ); } if( replace_directives.empty() ) { - std::copy(mfile.cur, mfile.eol, ofs); + output_segment(mfile.cur, mfile.eol, ofs); continue; // No active REPLACE directive. } std::list<span_t> segments = segment_line(mfile); for( const auto& segment : segments ) { - std::copy(segment.p, segment.pend, ofs); + output_segment(segment.p, segment.pend, ofs); } out.flush(); @@ -2012,7 +2028,7 @@ cdftext::process_file( filespan_t mfile, int output, // end of file if( !second_pass && --nfiles ) { static const char file_pop[] = "\f#FILE POP\f"; - std::copy(file_pop, file_pop + strlen(file_pop), ofs); + output_segment(file_pop, file_pop + strlen(file_pop), ofs); out.flush(); } if( !included_files.empty() ) { --nfiles; }; diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 8b0362183438..24a9977c8116 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -942,7 +942,7 @@ class locale_tgt_t { %type <data_category> init_categora init_category %type <replacement> init_by %type <replacements> init_bys init_replace -%type <refer> init_data exit_with stop_status +%type <refer> init_data exit_giving exit_with stop_status %type <cce_type> cce_expr cce_factor const_value %type <prog_end> end_program1 %type <substitution> subst_input @@ -4619,10 +4619,8 @@ data_clauses: data_clause YYERROR; } if( parent->occurs.ntimes() > 0 ) { - error_msg(@1, "%s cannot REDEFINE table %s", - current_field()->name, - parent->name); - YYERROR; + if( ! dialect_ok(@1, MfRedefinesTable, + "REDEFINE table") ) YYERROR; } } data_clause_t clause = data_clause_t($1); @@ -6270,10 +6268,11 @@ name88: NAME88 { name_queue.qualify(@1, $1); auto namelocs( name_queue.pop() ); auto names( name_queue.namelist_of(namelocs) ); + auto inner = namelocs.back(); if( ($$ = field_find(@1, names)) == NULL ) { if( procedure_div_e == current_division ) { error_msg(namelocs.back().loc, - "DATA-ITEM '%s' not found", names.back() ); + "DATA-ITEM %qs not found", inner.name ); YYERROR; } } @@ -6699,6 +6698,18 @@ end_program1: END_PROGRAM namestr[name] $$.token = END_FUNCTION; $$.name = $name; } + | END_FUNCTION FUNCTION_UDF[name] + { + $$.loc = @name; + $$.token = END_FUNCTION; + $$.name = literal_of(cbl_label_of(symbol_at($name))->name); + } + | END_FUNCTION FUNCTION_UDF_0[name] + { + $$.loc = @name; + $$.token = END_FUNCTION; + $$.name = literal_of(cbl_label_of(symbol_at($name))->name); + } | END_PROGRAM '.' // error { $$.loc = @1; @@ -6776,6 +6787,7 @@ exit_with: %empty } ; exit_what: PROGRAM_kw { parser_exit_program(); } + | PROGRAM_kw exit_giving { parser_exit(*$2); } | PROGRAM_kw exit_raising[ec] { parser_exit_program(); } | SECTION { parser_exit_section(); } | PARAGRAPH { parser_exit_paragraph(); } @@ -6788,7 +6800,11 @@ exit_what: PROGRAM_kw { parser_exit_program(); } parser_exit_perform(&perform_current()->tgt, $1); } ; - +exit_giving: retgiv num_value { $$ = $num_value; } + ; +retgiv: GIVING + | RETURNING + ; exit_raising: RAISING EXCEPTION EXCEPTION_NAME[ec] { $$ = $ec; @@ -8247,6 +8263,7 @@ stop_status: status { $$ = NULL; } | status NUMSTR { $$ = new_reference(new_literal(@2, $2.string, $2.radix)); } + | OMITTED { $$ = NULL; } ; subscripts: LPAREN subscript_exprs ')' { @@ -9210,7 +9227,7 @@ write_body: write_what[field] advance_when[when] advancing statement_begin(@$, WRITE); cbl_file_t *file = symbol_record_file($field); if( !file ) { - error_msg(@1, "no FD record found for %s", $field->name); + error_msg(@1, "no FD record found for %qs", $field->name); YYERROR; } $$ = file_write_args.init( file, $field, $when==AFTER, $advancing ); @@ -9221,7 +9238,7 @@ write_body: write_what[field] advance_when[when] advancing statement_begin(@$, WRITE); cbl_file_t *file = symbol_record_file($field); if( !file ) { - error_msg(@1, "no FD record found for %s", $field->name); + error_msg(@1, "no FD record found for %qs", $field->name); YYERROR; } cbl_refer_t lines; @@ -9253,7 +9270,7 @@ file_record: NAME auto names( name_queue.namelist_of(namelocs) ); auto inner = namelocs.back(); if( ($$ = field_find(@1, names)) == NULL ) { - error_msg(inner.loc, "no record name '%s'", inner.name); + error_msg(inner.loc, "no record name %qs", inner.name); YYERROR; } } @@ -9510,10 +9527,15 @@ rewrite1: REWRITE rewrite_body end_rewrite { rewrite_body: write_what record { statement_begin(@$, REWRITE); - symbol_elem_t *e = symbol_file(PROGRAM, $1->name); - file_rewrite_args.init(cbl_file_of(e), $1); - $$.file = cbl_file_of(e); - $$.buffer = $1; + cbl_field_t *field = $write_what; + cbl_file_t *file = symbol_record_file(field); + if( !file ) { + error_msg(@1, "no FD record found for %qs", field->name); + YYERROR; + } + file_rewrite_args.init(file, field); + $$.file = file; + $$.buffer = field; } ; end_rewrite: %empty %prec REWRITE @@ -10265,12 +10287,23 @@ filenames: filename { $$ = new file_list_t($1); } ; filename: NAME { - struct symbol_elem_t *e = symbol_file(PROGRAM, $1); - if( !(e && e->type == SymFile) ) { - error_msg(@NAME, "invalid file name"); + struct symbol_elem_t *e = symbol_file(PROGRAM, $NAME); + if( e ) { + $$ = cbl_file_of(e); + } else { + $$ = nullptr; + name_queue.qualify(@NAME, $NAME); + auto namelocs( name_queue.pop() ); + auto names( name_queue.namelist_of(namelocs) ); + cbl_field_t *field = field_find(@NAME, names); + if( field ) { + $$ = symbol_record_file(field); + } + } + if( ! $$ ) { + error_msg(@NAME, "invalid file name %qs", $NAME); YYERROR; } - $$ = cbl_file_of(e); } | device_name[dev] { @@ -10279,7 +10312,7 @@ filename: NAME YYERROR; auto e = symbol_file(PROGRAM, dev->name); if( ! e ) { - error_msg(@dev, "no FD selected for device '%s'", dev->name); + error_msg(@dev, "no FD selected for device %qs", dev->name); YYERROR; } $$ = cbl_file_of(e); diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 66baf74320dd..2645020658a2 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -88,7 +88,6 @@ BLANK [[:blank:]]+ OBLANK [[:blank:]]* EOL \r?\n BLANK_EOL [[:blank:]]*{EOL} -BLANK_OEOL [[:blank:]]*{EOL}? PICTURE [^[:space:]]+ @@ -106,9 +105,13 @@ EOPIC [.,;]?[[:space:]] SKIP [[:blank:]]*SKIP[123][[:blank:]]*[.]?{BLANK_EOL} +NAME [[:alnum:]]+([_-]+[[:alnum:]]+)* + COUNT [(][[:digit:]]+[)] -N9 9+|(9{COUNT}) -NP P+|(P{COUNT}) +NAMECOUNT [(]{NAME}[)] + +N9 9+|9{COUNT}|9{NAMECOUNT} +NP P+|P{COUNT} UNSIGNED [[:space:]]+UNSIGNED SIGNED [[:space:]]+SIGNED @@ -158,7 +161,6 @@ DATETIME_FMT ({DATE_FMT_B}T{TIME_FMT_B})|({DATE_FMT_E}T{TIME_FMT_E}) TITLE TITLE -NAME [[:alnum:]]+([_-]+[[:alnum:]]+)* SUBELEMS {NAME}({SPC}{NAME})* EOP (EOP|END-OF-PAGE) @@ -296,12 +298,11 @@ PROGRAM-ID{OSPC}{DOTSEP}? { yy_push_state(ident_state); <comment_entries>{ (ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION { myless(0); yy_pop_state(); } + {COMMENTARY}.* {BLANK_EOL} - [^[:space:]]{1,512}{BLANK_OEOL} // about 1/2 KB at a time } <ident_state>{ - {BLANK_OEOL} EJECT{DOTEOL}? { dialect_ok(yylloc, IbmEjectE, "EJECT"); } ID(ENTIFICATION)?{SPC}DIVISION { myless(0); yy_pop_state(); } (ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION { @@ -312,7 +313,7 @@ PROGRAM-ID{OSPC}{DOTSEP}? { yy_push_state(ident_state); AS{SPC}[''] { yy_push_state(quoted1); return AS; } IS { pop_return IS; } - {COMMENTARY} { BEGIN(comment_entries); } + {COMMENTARY}.* { BEGIN(comment_entries); } } <INITIAL>{ @@ -1358,9 +1359,6 @@ USE({SPC}FOR)? { return USE; } * Any blank or separator period ends terminates the picture. */ <picture>{ - ^[[:blank:]]+ - ^{BLANK_EOL} - {COMMA} | [[:blank:]]*{EOL} | [[:blank:]]+{EOL}? { yy_pop_state(); /* embedded/trailing blank */ } @@ -1372,21 +1370,18 @@ USE({SPC}FOR)? { return USE; } /* Sign, if any, first */ S/({NP}|{N9}|V)+{EOPIC} { return picset('S'); } /* P's either lead (after sign) or trail, with any V adjacent, see Table 10. */ - V?{NP}/{N9}*{EOPIC} { yylval.number = ndigit(yyleng); return picset(PIC_P); } - {NP}V?/{EOPIC} { yylval.number = ndigit(yyleng); return picset(PIC_P); } + V?{NP}/{N9}*{EOPIC} { yylval.number = ndigit(yyleng); return picset(PIC_P); } + {NP}V?/{EOPIC} { yylval.number = ndigit(yyleng); return picset(PIC_P); } /* Parser accepts any sequence of 9's with one optional V. */ - {N9}?V/{N9}*{EOPIC} { yylval.number = ndigit(yyleng - 1); return picset(NINEV); } - {N9}/{NP}?V?{EOPIC} { yylval.number = ndigit(yyleng); return picset(NINES); } - /* Match 99(5) as 9 and 9(5) */ - 99+{COUNT}/(V|{N9})*{EOPIC} { - auto len = length_upto('('); - yylval.number = len; - myless(len); - return picset(NINES); - } - [9P]+[(]{NAME}[)] { - cbl_unimplemented_at(yylloc, "unimplemented: symbolic count for numeric PICTURE" ); - } + {N9}*V/{N9}*{EOPIC} { yylval.number = ndigit(yyleng - 1); return picset(NINEV); } + {N9}+{NP}?V?{EOPIC} { const char *p = yytext + yyleng; + yylval.number = ndigit(yyleng, &p); + int len = p - yytext; + int token = picset(NINES, len); + if( len < yyleng ) myless(len); + return token; } + + [9P]+[(]{NAME}[)] { gcc_unreachable(); } 1{1,31}/({COUNT}|[(]{NAME}[)]) { yy_push_state(picture_count); @@ -1505,7 +1500,12 @@ USE({SPC}FOR)? { return USE; } [""]{SPC}[&]{SPC}[""''] { if( yytext[yyleng - 1] == '\'' ) BEGIN(quoted1); } - [""]-{OSPC}({EOL}{OSPC})+[""] /* continue ... */ + [""]-{OSPC}{EOL} { // string continuation + int ch = continue_string(*yytext); + if( ch != *yytext ) { + error_msg(yylloc, "invalid string continuation"); + } + } [""] { char *s = xstrdup(tmpstring? tmpstring : "\0"); yylval.literal.set_data(strlen(s), s); @@ -1522,7 +1522,12 @@ USE({SPC}FOR)? { return USE; } ['']{SPC}[&]{SPC}[""''] { if( yytext[yyleng - 1] == '"' ) BEGIN(quoted2); } - ['']-{OSPC}({EOL}{OSPC})+[''] /* continue ... */ + ['']-{OSPC}{EOL} { // string continuation + int ch = continue_string(*yytext); + if( ch != *yytext ) { + error_msg(yylloc, "invalid string continuation"); + } + } [''] { char *s = xstrdup(tmpstring? tmpstring : "\0"); yylval.literal.set_data(strlen(s), s); @@ -2025,7 +2030,6 @@ USE({SPC}FOR)? { return USE; } } <program_id_state>{ - {BLANK_OEOL} (IS)?[[:space:]] AS/{SPC} { myless(0); yy_pop_state(); } /* => ident_state */ @@ -2041,8 +2045,6 @@ USE({SPC}FOR)? { return USE; } } <name_state>{ /* Either pop from here, or let the quoted state pop */ - {BLANK_OEOL} - {NAME} { yy_pop_state(); yylval.string = xstrdup(yytext); return NAME; @@ -2078,7 +2080,7 @@ USE({SPC}FOR)? { return USE; } {PREFIX}?[""]/{STRING2}[""] { yylval.literal.set_prefix(yytext, yyleng-1); yy_push_state(quoted2); } - {INTEGERZ}/[[:punct:]][[:space:]]{BLANK_OEOL} { return numstr_of(yytext); } + {INTEGERZ}/[[:punct:]][[:space:]]{BLANK_EOL}? { return numstr_of(yytext); } {dfc}/[[:blank:][:punct:]] { return numstr_of(yytext); } [+-]?({dfc}|{dseq})([.,][[:digit:]])* { auto eotext = yytext + yyleng - 1; @@ -2301,8 +2303,8 @@ USE({SPC}FOR)? { return USE; } auto p = std::find_if(beg, end, []( char ch ) { return ISSPACE(ch); }); auto len = p.base() - yytext; myless(len); // avoid dangerous trailing context - return LENGTH_OF; } - + return LENGTH_OF; + } {NAME}/{SPC}(IN|OF)[[:space:]] { tee_up_name(yylloc, xstrdup(yytext)); } @@ -2568,7 +2570,7 @@ USE({SPC}FOR)? { return USE; } [*]CBL { return STAR_CBL; } [*]CONTROL { return STAR_CBL; } -(PROCESS|CBL)({BLANK}.*)?/{EOL} { +(PROCESS|CBL)({BLANK}.*)?{EOL} { yylval.string = xstrdup(yytext); for(char *p = yylval.string + strlen(yylval.string) - 1; *p == 0x20; p-- ) { diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index d13174b8d3a3..6e0898d42e84 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -58,7 +58,7 @@ int repository_function_tok( const char name[] ); void next_sentence_label(cbl_label_t*); -int repeat_count( const char picture[] ); +std::pair<int, int> repeat_count(const char picture[]); size_t program_level(); @@ -712,21 +712,47 @@ level_of( const char input[] ) { return output; } -// Called by lexer with leading or trailing V, which is ignored. -static inline int -ndigit(int len) { - const char *input = yytext + (TOUPPER(yytext[0]) == 'V'? 1 : 0); - if( input == yytext + yyleng ) return 0; // Only the V - int n = repeat_count(input); - return n == -1? len : n; +/* + * Input may have leading or trailing V, which is ignored. + * Return the decoded picture size insofar as possible. + * If the picture switches from 9s to Ps, say, set pleft to the remainder. + */ +static int +ndigit(int len, const char **pleft = nullptr) { + const char *p = yytext, *pend = yytext + len; + 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++; + if( p[1] == model ) continue; + + std::pair<int,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; + } + --n += count; // the 9 before the paren in 9(8) doesn't count + p += pos; + if( *p != model ) { + if( pleft ) *pleft = p; + break; + } + --p; // point to closing parenthesis + } + return n; } static int -picset( int token ) { +picset( int token, int leng = yyleng ) { static const char * const eop = orig_picture + sizeof(orig_picture); char *p = orig_picture + strlen(orig_picture); - if( eop < p + yyleng ) { + if( eop < p + leng ) { error_msg(yylloc, "PICTURE exceeds maximum size of %zu bytes", sizeof(orig_picture) - 1); } @@ -1145,57 +1171,13 @@ in_identification_division(); bool in_procedure_division(); bool in_environment_division(); -static const char * -symbol_lower_name( const symbol_elem_t *e, cbl_name_t lname ) { - const char *pname = nullptr; - - switch(e->type) { - case SymFile: - pname = cbl_file_of(e)->name; - break; - case SymField: - pname = cbl_field_of(e)->name; - break; - case SymLabel: - pname = cbl_label_of(e)->name; - break; - default: - return nullptr; - } - gcc_assert(pname); - std::fill(lname, lname + sizeof(cbl_name_t), '\0'); - std::transform( pname, pname + strlen(pname) + 1, lname, tolower ); - return lname; -} - static symbol_elem_t * -symbol_exists( const char name[], const symbol_elem_t *constant = nullptr ) { - typedef std::map <std::string, size_t> name_cache_t; - static std::map <size_t, name_cache_t> cachemap; - - cbl_name_t lname; - std::transform( name, name + strlen(name) + 1, lname, tolower ); - auto& cache = cachemap[PROGRAM]; - +symbol_exists( const char name[] ) { if( in_procedure_division() ) { - if( cache.empty() ) { - for( auto e = symbols_begin(PROGRAM) + 1; - e < symbols_end() && PROGRAM == e->program; e++ ) { - cbl_name_t name; - const char *pname = symbol_lower_name(e, name); - if( pname ) { - cache[pname] = symbol_index(e); - } - } - cache.erase(""); // remove unnamed symbols - } - if( constant ) { // Johnny-come-lately named literal from CDF. - gcc_assert(constant->type == SymField); - cache[lname] = symbol_index(constant); - } - auto p = cache.find(lname); - if( p == cache.end() ) return nullptr; - return symbol_at(p->second); + auto names = teed_up_names(); + names.push_front(name); + auto found = symbol_find( PROGRAM, names, false); + return found.second? found.first : nullptr; } /* * Before data division has been defined and the cache populated, search the @@ -1205,14 +1187,6 @@ symbol_exists( const char name[], const symbol_elem_t *constant = nullptr ) { return e; } -void -scanner_cache_update( const symbol_elem_t *elem ) { - if( elem->type == SymField ) { - auto f = cbl_field_of(elem); - symbol_exists(f->name, elem); - } -} - static int typed_name( const char name[] ) { if( 0 == PROGRAM ) return NAME; @@ -1232,6 +1206,7 @@ typed_name( const char name[] ) { } } break; + case FUNCTION_UDF: case FUNCTION_UDF_0: yylval.number = symbol_function_token(name); __attribute__((fallthrough)); @@ -1354,6 +1329,28 @@ static inline bool is_quote( const char ch ) { static int yyinput(); 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; + case '\n': + yylloc.last_line = ++yylineno; + yylloc.last_column = 0; + break; + default: + if( ! ISSPACE(ch) ) { + return ch; + } + } + } + + yylloc.last_column++; + return ch; +} + static std::string skip_string(char delimiter) { int ch; diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index b41977c043f5..acc2bca25846 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -104,7 +104,7 @@ static struct symbol_table_t { struct symbol_elem_t *elems; - std::map<elem_key_t, size_t> specials, programs, functions; + std::map<elem_key_t, size_t> specials, files, programs, functions; std::map<elem_key_t, std::list<size_t>> labels; std::vector<symbol_pair_t> mappings; @@ -136,13 +136,20 @@ static struct symbol_table_t { const char *name = cbl_label_of(e)->name; labels[ elem_key_t(e->program, name) ].push_back( symbol_index(e) ); } + void file_add( size_t isym ) { + auto e = elems + isym; + auto L = cbl_file_of(e); + elem_key_t key(e->program, L->name); + files[key] = isym; + } + void program_add( size_t isym ) { label_add(programs, isym); } void function_add( size_t isym ) { label_add(functions, isym); } protected: void label_add( std::map<elem_key_t, size_t>& M, size_t isym ) { auto e = elems + isym; auto L = cbl_label_of(e); - auto key( elem_key_t(e->program, L->name) ); + elem_key_t key(e->program, L->name); M[key] = isym; } } symbols; @@ -677,7 +684,6 @@ enum protoreq_t { static struct symbol_elem_t * symbol_function_impl( size_t parent, const char name[], protoreq_t protoreq ) { -#if 1 auto key( elem_key_t(parent, name) ); auto p = symbols.functions.find(key); if( p == symbols.functions.end() ) return nullptr; @@ -686,29 +692,6 @@ symbol_function_impl( size_t parent, const char name[], protoreq_t protoreq ) if( protoreq == proto_required_e && !L->prototype ) return nullptr; if( protoreq == proto_disallowed_e && L->prototype ) return nullptr; return e; -#else - auto p = std::find_if( symbols_begin(), symbols_end(), - [parent, name, protoreq]( const auto& elem ) { - if( elem.type == SymLabel ) { - auto L = cbl_label_of(&elem); - if( L->type == LblFunction ) { - if( protoreq == proto_required_e && !L->prototype ) { - return false; - } - if( protoreq == proto_disallowed_e && L->prototype ) { - return false; - } - // allowed or meets above requirement - return 0 == strcasecmp(L->name, name); - } - } - return false; - } ); - - if( yydebug && p == symbols_end() ) symbols_dump( symbols.first_program, true); - - return p == symbols_end()? NULL : p; -#endif } struct symbol_elem_t * @@ -2790,6 +2773,8 @@ symbol_file_add( size_t program, cbl_file_t *file ) { same_record_areas[f.same_record_as].insert(symbol_index(e)); } + symbols.file_add( symbol_index(e) ); + return e; } @@ -3094,47 +3079,30 @@ symbol_literalA( size_t program, const char name[] ) struct symbol_elem_t * symbol_file( size_t program, const char name[] ) { - size_t nelem = symbols.nelem; - symbol_elem_t key{ SymFile, program }, *e = &key; - - assert(strlen(name) < sizeof(key.elem.file.name)); - strcpy(key.elem.file.name, name); - - // cppcheck-suppress-begin [knownConditionTrueFalse] - do { - e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems, - &nelem, sizeof(*e), - symbol_elem_cmp ) ); - if( e ) break; - key.program = cbl_label_of(symbol_at(key.program))->parent; - if( key.program == 0 ) break; // no file without a program - } while( !e ); - // cppcheck-suppress-end [knownConditionTrueFalse] - - if( e ) { - assert(e->type == SymFile); - return e; - } - - // perhaps a record name? - for( e = symbol_field(program, 0, name); e != NULL; e = symbol_parent(e) ) { - if( e->type == SymFile ) { - return e; - } - if( e->type != SymField ) { - dbgmsg("%s:%d: '%s' is not a file and has parent of type %s", - __func__, __LINE__, name, symbol_type_str(e->type)); - return NULL; - } - if( symbol_index(e) == 0 ) { - dbgmsg("%s:%d: '%s' is not a file and has no parent", - __func__, __LINE__, name); - return NULL; + 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; + p = symbols.files.find(key); + if( p != symbols.files.end() ) { + auto f = cbl_file_of(symbol_at(p->second)); + if( f->attr & global_e ) break; + } } } - assert(!e); - return e; + if( key.program ) { + gcc_assert(p != symbols.files.end()); + dbgmsg("%s:%d: found: %s as #%lu", __func__, __LINE__, + name, (unsigned long)p->second); + auto e = symbol_at(p->second); + return e; + } + + dbgmsg("%s:%d: not found: %s", __func__, __LINE__, name); + return nullptr; } struct symbol_elem_t * diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 9cbe09cf3f31..8134c9fbb952 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -2396,7 +2396,7 @@ bool was_fd_name( const cbl_field_t * field ); // uses symbol_map2, sort of symbol_elem_t * symbol_register( const char name[] ); std::pair<symbol_elem_t *, bool> -symbol_find( size_t program, std::list<const char *> names ); +symbol_find( size_t program, std::list<const char *> names, bool diagnose = true ); symbol_elem_t * symbol_find_of( size_t program, std::list<const char *> names, size_t group ); @@ -2805,10 +2805,11 @@ struct cbl_nameloc_t { #include <queue> typedef std::list<const char *> cbl_namelist_t; typedef std::list<cbl_nameloc_t> cbl_namelocs_t; + class name_queue_t : private std::queue<cbl_namelocs_t> { friend void tee_up_empty(); - cbl_namelocs_t recent; + const cbl_namelocs_t none; void allocate() { std::queue<cbl_namelocs_t>::push( cbl_namelocs_t() ); @@ -2840,7 +2841,7 @@ class name_queue_t : private std::queue<cbl_namelocs_t> } cbl_namelocs_t pop() { assert(!empty()); - recent = front(); + auto recent = front(); std::queue<cbl_namelocs_t>::pop(); dump(__func__); return recent; @@ -2851,7 +2852,7 @@ class name_queue_t : private std::queue<cbl_namelocs_t> void dump( const char tag[] ) const; - cbl_namelocs_t peek() const { dump(__func__); return empty()? recent : back(); } + cbl_namelocs_t peek() const { dump(__func__); return empty()? none : back(); } bool empty() const { return std::queue<cbl_namelocs_t>::empty(); } size_t size() const { return std::queue<cbl_namelocs_t>::size(); } diff --git a/gcc/cobol/symfind.cc b/gcc/cobol/symfind.cc index 20d44170832e..ebf7f5317b4b 100644 --- a/gcc/cobol/symfind.cc +++ b/gcc/cobol/symfind.cc @@ -585,7 +585,7 @@ symbol_match2( size_t program, * N-1. */ static symbol_map_t -symbol_match( size_t program, const std::list<const char *>& names ) { +symbol_match( size_t program, const std::list<const char *>& names, bool diagnose ) { auto matched = symbol_match2( program, names ); symbol_map_t output; @@ -600,7 +600,7 @@ symbol_match( size_t program, const std::list<const char *>& names ) { continue; } auto inserted = output.insert(*p); - if( ! inserted.second ) { + if( diagnose && ! inserted.second ) { error_msg_direct("%s is not a unique reference", key.name); } } @@ -619,8 +619,8 @@ symbol_field_alias_end() { } std::pair <symbol_elem_t *, bool> -symbol_find( size_t program, std::list<const char *> names ) { - symbol_map_t items = symbol_match(program, names); +symbol_find( size_t program, std::list<const char *> names, bool diagnose ) { + symbol_map_t items = symbol_match(program, names, diagnose); if( symbol_field_alias_01 && items.size() != 1 ) { symbol_map_t qualified; @@ -673,7 +673,7 @@ public: symbol_elem_t * symbol_find_of( size_t program, std::list<const char *> names, size_t group ) { - symbol_map_t input = symbol_match(program, names); + symbol_map_t input = symbol_match(program, names, true); symbol_map_t items; std::copy_if( input.begin(), input.end(), diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index 54181138b78c..027f409f7b70 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -347,12 +347,9 @@ cdf_file_name( const cbl_file_t *file ) { void cdf_field_add( const cbl_loc_t& loc, const std::string& name, const cdfval_t& value ) { - void scanner_cache_update( const symbol_elem_t *elem ); - if( symbols_begin() < symbols_end() ) { cbl_field_t field = cdf_literalize(loc, name, value); - auto e = symbol_field_add(current_program_index(), &field); - scanner_cache_update( e ); + symbol_field_add(current_program_index(), &field); } } @@ -545,20 +542,55 @@ determine_intermediate_type( const cbl_refer_t& aref, static char regexmsg[80]; +static int +named_constant( const cbl_name_t name ) { + int output = -1; + + auto e = symbol_field( current_program_index(), 0, name ); + if( e && e->type == SymField ) { + auto f = cbl_field_of(e); + if( f->has_attr(constant_e) && is_numeric(f->type) ) { + auto result = f->data.int64_of(); + if( result.second) output = result.first; + } + } + return output; +} + /* - * Scan part of the picture, parsing any repetition count. + * Scan part of the picture, parsing any repetition count. Return the parsed + * count (a named constant, perhaps), and an index to any remaining input. Use + * negative position to indicate failure. */ -int -repeat_count( const char picture[] ) +extern cbl_loc_t yylloc; + +std::pair<int, int> +repeat_count(const char picture[]) { char ch; - int n, count = -1; + int count = 0, pos = -1; + + int n = sscanf(picture, "%c(%d)%n", &ch, &count, &pos); - n = sscanf( picture, "%c(%d)", &ch, &count ); - if( count <= 0 && 4 < n ) { // parsed count is negative - count = 0; // zero is invalid; -1 means no repetition + if( n == 2 ) { + if( count < 0 ) { + error_msg(yylloc, "not a positive integer constant: %d", count); + } + } else { + cbl_name_t name; + n = sscanf(picture, "%c(%s)%n", &ch, name, &pos); + if( n == 2 ) { + if( (count = named_constant(name)) < 0 ) { + error_msg(yylloc, "not a positive integer constant: %qs: %d", name, count); + } + } + } + + if( n == 2 && 0 <= count ) { + return {count, pos}; } - return count; + + return {0, -1}; } const char *numed_message;
