https://gcc.gnu.org/g:8667057b82d664967d290b7ac78d91736b712ff4
commit r17-4169-g8667057b82d664967d290b7ac78d91736b712ff4 Author: James K. Lowden <[email protected]> Date: Thu Sep 10 22:18:06 2026 -0400 cobol: Revise application of COBOL-WORDS. Rather than the scanner applying COBOL-WORDS itself, let the generated scanner do its thing. When the token is retrieved from the lexer() function, apply the COBOL-WORDS overrides. Not all keywords can be successfully modified at present. gcc/cobol/ChangeLog: * parse_ante.h (redefined_token): Add token parameter. * scan.l: Do not use redefined_token in the scanner. * scan_ante.h (typed_name): Same. * scan_post.h (next_token): Use redefined_token in the lexer wrapper. * symbols.h (redefined_token): Declaration matches definition. (class current_tokens_t): Document, and use enumerated constants. Diff: --- gcc/cobol/parse_ante.h | 4 +-- gcc/cobol/scan.l | 4 --- gcc/cobol/scan_ante.h | 2 -- gcc/cobol/scan_post.h | 31 +++++++++++++++-- gcc/cobol/symbols.h | 93 +++++++++++++++++++++++++++++++++++++++++++++----- 5 files changed, 116 insertions(+), 18 deletions(-) diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index 54a4f90b86b4..c3214ce75b95 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -1207,8 +1207,8 @@ teed_up_names() { #define cdf_tokens cdf_current_tokens() int -redefined_token( const cbl_name_t name ) { - return cdf_tokens.redefined_as(name); +redefined_token( const cbl_name_t name, int token ) { + return cdf_tokens.redefined_as(name, token); } static bool diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 9e715a25dfb6..8b85d710e320 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -2568,8 +2568,6 @@ USE({SPC}FOR)? { return USE; } if( 0 != (yylval.number = symbol_function_token(name)) ) { pop_return FUNCTION_UDF; } - int token = NAME; - if( (token = redefined_token(name)) ) { return token; } yylval.string = name; pop_return NAME; } @@ -2581,8 +2579,6 @@ USE({SPC}FOR)? { return USE; } if( 0 != (yylval.number = symbol_function_token(name)) ) { pop_return FUNCTION_UDF_0; } - int token = NAME; - if( (token = redefined_token(name)) ) { return token; } yylval.string = name; pop_return NAME; } diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index 115dbff07eac..b6172cbe0bc4 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -1230,8 +1230,6 @@ typed_name( const char name[] ) { if( name ) return token; } - if( (token = redefined_token(name)) ) { return token; } - e = symbol_exists( name ); auto type = e && e->type == SymField? cbl_field_of(e)->type : FldInvalid; diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h index a60abfa8ecfa..967d81662f4d 100644 --- a/gcc/cobol/scan_post.h +++ b/gcc/cobol/scan_post.h @@ -260,11 +260,38 @@ namespace cdf { bool had_lookahead(); cbl_loc_t location(); int last_lexed; + bool any_cobol_words = false; } static int next_token() { - cdf::last_lexed = lexer(); - return cdf::last_lexed; + int token = cdf::last_lexed = lexer(); + + if( cdf::any_cobol_words ) { + const char *name = token == NAME? yylval.string : nullptr; + token = redefined_token(name, token); + if( token != cdf::last_lexed ) { + const char *name = 0 < token? keyword_str(token) : "lost"; + if( cdf::last_lexed == NAME ) { + dbgmsg("%s:%d: NAME '%s' became '%s' (%d)", __func__, __LINE__, + yylval.string, name, token); + } else { + dbgmsg("%s:%d: %s (%d) became %d for '%s'", __func__, __LINE__, + keyword_str(cdf::last_lexed), cdf::last_lexed, + token, yytext); + } + } + if( current_tokens_t::is_reserved(token) ) { + error_msg(yylloc, "RESERVED by COBOL-WORDS: %qs", yytext); + token = cdf::last_lexed; + } + if( current_tokens_t::is_undefined(token) ) { + yylval.string = xstrdup(yytext); + token = NAME; + dbgmsg("%s:%d: UNDEFINED by COBOL-WORDS: %s becomes user-defined name", + __func__, __LINE__, yytext? yytext : "yytext is NULL?"); + } + } + return token; } // act on CDF tokens diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 94af43938256..736d6e7b3a99 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -2967,15 +2967,71 @@ void wsclear( uint32_t ch); const uint32_t *wsclear(); int keyword_tok( const char * text, bool include_intrinsics = false ); -int redefined_token( const cbl_name_t name ); +int redefined_token( const cbl_name_t name, int token ); +/* + * The tokenset for any translation can be changed by COBOL-WORDS, which must + * appear before IDENTIFICATION SECTION. The directive may add, delete, or + * modify reserved words and context-sensitive words, and the names of + * 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. + * It is used by redefined_token. + * - cobol_words enforces the rule that any token name may appear at + * most 1 time in int the COBOL-WORDS directive. + * + * 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. + * + * 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. + + * 2. Semantic values are known only to the lexer. Some tokens carry a value + * representing their context. For example, both INVALID and NOT INVALID + * are presented to the parser as INVALID, with the semantic value + * representing the presence (or absence) of NOT. If BOGUS is substituted + * for INVALID, the generated lexer will assume BOGUS is a NAME, and + * 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. + * + * 4. Renamed tokens that trigger changes in Start Condition are either not + * detected by the lexer, or (as names) mistakenly change the SC. + * + * A robust solution to these problems is tail-wagging-the-dog for this + * project. The lexer could be completely rewritten, discarding GNU Flex in + * favor of runtime-defined tables. That however represents months of work for + * programs that constitute a rounding error in the global COBOL corpus. A + * smaller, feasible solution would reject attempts to use COBOL-WORDS that + * affect the above problems. The interested reader of this comment is invited + * to tackle it. + */ +namespace cdf { extern bool any_cobol_words; } class current_tokens_t { class tokenset_t { // token_names is initialized from a generated header file. std::vector<const char *>token_names; // position indicates token value std::map <std::string, int> tokens; // aliases - std::set<std::string> cobol_words; // Anything in COBOL-WORDS may appear only once. + std::set<std::string> cobol_words; // COBOL-WORDS may affect a word only once. + std::set<int> undefined; // removed keywords public: + enum { reserved_e = -42, undefined_e = -77 }; + static std::string lowercase( const cbl_name_t name ) { cbl_name_t lname; @@ -3001,6 +3057,7 @@ class current_tokens_t { error_msg(loc, "COBOL-WORDS %s: %qs may appear but once", verb, name); return false; } + cdf::any_cobol_words = true; auto p = tokens.find(lowercase(name)); bool fOK = p == tokens.end(); if( fOK ) { // name not already in use @@ -3024,6 +3081,9 @@ class current_tokens_t { auto p = tokens.find(lname); bool fOK = p != tokens.end(); if( fOK ) { // name in use + cobol_words.insert(p->first); + cdf::any_cobol_words = true; + undefined.insert(p->second); tokens.erase(p); } else { error_msg(loc, "%s: not a reserved word: %qs", verb, name); @@ -3046,18 +3106,32 @@ class current_tokens_t { error_msg(loc, "COBOL-WORDS RESERVE: %qs may appear but once", name); return false; } - tokens[lname] = -42; + cdf::any_cobol_words = true; + tokens[lname] = reserved_e; return true; } - int redefined_as( const cbl_name_t name ) { + /* + * 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 + * + * Also the user might have removed the name. In that case, the generated + * lexer (being unaware of the deletion, found it and returned the token + * value. If it is in the undefined list, return 0. + */ + int redefined_as( const cbl_name_t name, int token ) { + if( 1 == undefined.count(token) ) return undefined_e; + if( ! name ) return token; + auto lname( lowercase(name) ); if( cobol_words.find(lname) != cobol_words.end() ) { auto p = tokens.find(lname); if( p != tokens.end() ) { - return p->second; + return p->second; // found a token for name } } - return 0; + return token; } const char * name_of( int tok ) const { tok -= (255 + 3); @@ -3068,6 +3142,9 @@ class current_tokens_t { tokenset_t tokens; public: + bool static is_reserved( int token ) { return token == tokenset_t::reserved_e; } + bool static is_undefined( int token ) { return token == tokenset_t::undefined_e; } + current_tokens_t() {} int find( const cbl_name_t name, bool include_intrinsics ) { return tokens.find(name, include_intrinsics); @@ -3115,8 +3192,8 @@ class current_tokens_t { bool reserve( const cbl_loc_t& loc, const cbl_name_t name ) { return tokens.reserve(loc, name); } - int redefined_as( const cbl_name_t name ) { - return tokens.redefined_as(name); + int redefined_as( const cbl_name_t name, int token ) { + return tokens.redefined_as(name, token); } const char * name_of( int tok ) const { return tokens.name_of(tok);
