## output set the mode variable. Everything else is appended to the
## opts variable.
##
+## - -fPIC is added to the command line if $mode is "-shared". That
+## option applies only to "certain machines", per the gcc info
+## manual. For this script to be portable across machines, -fPIC
+## would have to be set more judiciously.
if [ "$COBCPY" ]
then
*) if [ -z "$output_name" ] # first non-option argument is source file name
then
- output_name=$(basename ${opt%.*})
+ output_name=$(basename "${opt%.*}")
case $mode in
-c) output_name="$output_name".o
;;
-shared)
output_name="$output_name".so
+ opts="$opts -fPIC"
;;
esac
opts="$opts -o $output_name"
}
}
-#define linemap_add(...)
-
void
parser_enter_file(const char *filename)
{
}
}
- // Let the linemap routine know we are working on a new file:
- linemap_add(line_table, LC_ENTER, 0, filename, 1);
-
if( file_level == 0 )
{
// Build a translation_unit_decl:
SHOW_PARSE_TEXT(ach)
SHOW_PARSE_END
}
- if( file_level > 0)
- {
- linemap_add(line_table, LC_LEAVE, false, NULL, 0);
- }
file_level -= 1;
current_filename.pop_back();
}
}
-location_t
-location_from_lineno()
- {
- location_t loc;
- loc = linemap_line_start(line_table, sv_current_line_number, 0);
- return loc;
- }
-
void
gg_append_statement(tree stmt)
{
static replacing_term_t
parse_replacing_term( const char *stmt, const char *estmt ) {
- gcc_assert(stmt); gcc_assert(estmt); gcc_assert(stmt < estmt);
+ gcc_assert(stmt); gcc_assert(estmt); gcc_assert(stmt <= estmt);
replacing_term_t output(stmt);
static const char pattern[] =
cdftext::process_file( filespan_t mfile, int output, bool second_pass ) {
static size_t nfiles = 0;
- __gnu_cxx::stdio_filebuf<char> outbuf(fdopen(output, "w"), std::ios::out);
+ __gnu_cxx::stdio_filebuf<char> outbuf(fdopen(output, "a"), std::ios::out);
std::ostream out(&outbuf);
std::ostream_iterator<char> ofs(out);
continue; // No active REPLACE directive.
}
- // 1 segment for COPY, 2 for REPLACE
std::list<span_t> segments = segment_line(mfile);
for( const auto& segment : segments ) {
std::copy(segment.p, segment.pend, ofs);
}
+
out.flush();
}
// end of file
return output;
}
+ /*
+ * If the replacement changes the number of lines in the replaced text, we
+ * need to reset the line number, because the next statement is on a
+ * different line in the manipulated text than in the original. Before each
+ * replacement, set the original line number. After each replacement, set
+ * the line number after the elided text on the next line.
+ */
for( const replace_t& segment : pending ) {
gcc_assert(mfile.cur <= segment.before.p);
gcc_assert(segment.before.pend <= mfile.eodata);
+ struct { unsigned long ante, post; } lineno = {
+ gb4(mfile.lineno()), gb4(mfile.lineno() + segment.after.nlines())
+ };
+ char *directive = lineno.ante == lineno.post?
+ nullptr : xasprintf("\n#line %lu \"%s\"\n",
+ lineno.ante, cobol_filename());
+
+ if( directive )
+ output.push_back( span_t(strlen(directive), directive) );
output.push_back( span_t(mfile.cur, segment.before.p) );
output.push_back( span_t(segment.after.p, segment.after.pend ) );
+ if( directive )
+ output.push_back( span_t(strlen(directive), directive) );
mfile.cur = const_cast<char*>(segment.before.pend);
}
return output;
}
-
-//////// End of the cdf_text.h file
int size() const { return pend - p; }
+ size_t nlines() const { return p && pend? std::count(p, pend, '\n') : 0; }
+
span_t dup() const {
auto output = new char[size() + 1];
auto eout = std::copy(p, pend, output);
auto p = std::find(this->p, pend, '\0');
return p != pend? p : NULL;
}
+
+ bool at_eol() const {
+ return p < pend && '\n' == pend[-1];
+ }
+ const char * optional_eol() const {
+ return at_eol() ? "" : "\n";
+ }
};
struct replace_t {
%type <string> fd_name picture_sym name66 paragraph_name
%type <literal> literalism
%type <number> bound advance_when org_clause1 read_next
-%type <number> access_mode multiple lock_how lock_mode
+%type <number> access_mode multiple lock_how lock_mode org_is
%type <select_clauses> select_clauses
%type <select_clause> select_clause access_clause alt_key_clause
assign_clause collate_clause status_clause
%type <opt_arith> opt_arith_type
%type <module_type> module_type
+%type <nameloc> repo_func_name
+%type <namelocs> repo_func_names
+
%union {
bool boolean;
int number;
cbl_field_attr_t field_attr;
ec_type_t ec_type;
ec_list_t* ec_list;
+ cbl_nameloc_t *nameloc;
+ cbl_namelocs_t *namelocs;
declarative_list_t* dcl_list_t;
isym_list_t* isym_list;
struct { radix_t radix; char *string; } numstr;
$$.file->org = static_cast<cbl_file_org_t>($org);
}
;
-org_is: %empty
- | ORGANIZATION is
+org_is: %empty { $$ = 0; }
+ | ORGANIZATION is { $$ = 0; }
+ | ORGANIZATION is RECORD { $$ = RECORD; }
+ | RECORD { $$ = RECORD; }
;
// file_sequential is the proper default
-org_clause1: org_is SEQUENTIAL { $$ = file_sequential_e; }
- | org_is LINE SEQUENTIAL { $$ = file_line_sequential_e; }
- | org_is RELATIVE { $$ = file_relative_e; }
- | org_is INDEXED { $$ = file_indexed_e; }
+org_clause1: org_is SEQUENTIAL {
+ $$ = $1 == RECORD? file_line_sequential_e : file_sequential_e;
+ }
+ | org_is LINE SEQUENTIAL
+ {
+ if( $1 ) error_msg(@2, "syntax error: invalid %<RECORD%>");
+ $$ = file_line_sequential_e;
+ }
+ | org_is RELATIVE {
+ if( $1 ) error_msg(@2, "syntax error: invalid %<RECORD%>");
+ $$ = file_relative_e;
+ }
+ | org_is INDEXED {
+ if( $1 ) error_msg(@2, "syntax error: invalid %<RECORD%>");
+ $$ = file_indexed_e;
+ }
;
/*
repo_interface: INTERFACE NAME repo_as repo_expands
;
-repo_func: FUNCTION repo_func_names INTRINSIC
- {
- auto namelocs( name_queue.pop() );
- for( const auto& nameloc : namelocs ) {
- current.repository_add(nameloc.name);
+repo_func: FUNCTION repo_func_names[namelocs] INTRINSIC {
+ for( const auto& nameloc : *$namelocs ) {
+ if( 0 == intrinsic_token_of(nameloc.name) ) {
+ error_msg(nameloc.loc,
+ "no such intrinsic function: %qs",
+ nameloc.name);
+ continue;
+ }
+ current.repository_add(nameloc.name);
}
}
| FUNCTION ALL INTRINSIC
{
current.repository_add_all();
}
- | FUNCTION repo_func_names
- ;
-repo_func_names:
- repo_func_name
- | repo_func_names repo_func_name
- ;
-repo_func_name: NAME {
- if( ! current.repository_add($NAME) ) { // add intrinsic by name
- auto token = current.udf_in($NAME);
+ | FUNCTION repo_func_names[namelocs] {
+ // We allow multiple names because GnuCOBOL does. ISO says 1.
+ for( const auto& nameloc : *$namelocs ) {
+ if( 0 != intrinsic_token_of(nameloc.name) ) {
+ error_msg(nameloc.loc,
+ "intrinsic function %qs requires INTRINSIC",
+ nameloc.name);
+ continue;
+ }
+ auto token = current.udf_in(nameloc.name);
if( !token ) {
- error_msg(@NAME, "%s is not defined here as a user-defined function",
- $NAME);
- current.udf_dump();
- YYERROR;
+ error_msg(nameloc.loc,
+ "%s is not defined here as a user-defined function",
+ nameloc.name);
+ continue;
}
- auto e = symbol_function(0, $NAME);
+ auto e = symbol_function(0, nameloc.name);
assert(e);
current.repository_add(symbol_index(e)); // add UDF to repository
}
}
;
+repo_func_names:
+ repo_func_name[name] {
+ $$ = new cbl_namelocs_t(1, *$name);
+ delete $name;
+ }
+ | repo_func_names repo_func_name[name] {
+ $$ = $1;
+ $$->push_back(*$name);
+ delete $name;
+ }
+ ;
+repo_func_name: NAME repo_as {
+ if( ! $repo_as.empty() ) {
+ cbl_unimplemented_at(@repo_as, "%qs", $repo_as.data);
+ }
+ $$ = new cbl_nameloc_t(@NAME, $NAME);
+ }
+ ;
repo_program: PROGRAM_kw NAME repo_as
{
auto& ev( eval_stack.current() );
auto subj( ev.subject() );
if( !subj ) {
- error_msg(@1, "WHEN %s phrase exceeds "
+ error_msg(@1, "WHEN %qs phrase exceeds "
"subject set count of %zu",
- $a.term->name(), ev.subject_count());
+ nice_name_of($a.term->field), ev.subject_count());
YYERROR;
}
if( ! ev.compatible($a.term->field) ) {
auto obj($a.term->field);
error_msg(@1, "subject %s, type %s, "
- "cannot be compared %s, type %s",
- subj->name, 3 + cbl_field_type_str(subj->type),
- obj->name, 3 + cbl_field_type_str(obj->type) );
+ "cannot be compared %s, type %s",
+ subj->name, 3 + cbl_field_type_str(subj->type),
+ obj->name, 3 + cbl_field_type_str(obj->type) );
}
auto result = ev.compare(*$a.term);
if( ! result ) YYERROR;
assert( !programs.empty() );
function_descr_t arg = function_descr_t::init(name);
auto parg = std::find( function_descrs, function_descrs_end, arg );
- if( parg == function_descrs_end ) return false;
+ if( parg == function_descrs_end ) {
+ dbgmsg("%s:%d: no intrinsic %s found", __func__, __LINE__, name);
+ return false;
+ }
auto p = programs.top().function_repository.insert(*parg);
if( yydebug ) {
for( auto descr : programs.top().function_repository ) {
(Current).last_column = YYRHSLOC (Rhs, 0).last_column; \
} \
location_dump("parse.c", __LINE__, "current", (Current)); \
- gcc_location_set( location_set(Current) ); \
input_file_status_notify(); \
+ gcc_location_set( location_set(Current) ); \
} while (0)
int yylex(void);
static cbl_refer_t *
intrinsic_inconsistent_parameter( size_t n, cbl_refer_t *args );
+static int
+intrinsic_token_of( const char name[] );
+
static inline bool
namcpy(const YYLTYPE& loc, cbl_name_t tgt, const char *src ) {
// snprintf(3): writes at most size bytes (including the terminating NUL byte)
}
} else {
if( ! valid_move( tgt.field, src.field ) ) {
+ if( src.field->type == FldPointer &&
+ tgt.field->type == FldPointer ) {
+ if( dialect_mf() || dialect_gnu() ) return true;
+ dialect_error(src.loc, "MOVE POINTER", "mf");
+ }
if( ! is_index ) {
char ach[16];
char stype[32];
sprintf(ach, ".%d", tgt.field->data.rdigits);
strcat(dtype, ach);
}
-
error_msg(src.loc, "cannot MOVE '%s' (%s) to '%s' (%s)",
name_of(src.field), stype,
name_of(tgt.field), dtype);
}
};
+static int
+intrinsic_token_of( const char name[] ) {
+ auto pdescr = std::find_if( function_descrs, function_descrs_end,
+ [name]( const function_descr_t& descr ) {
+ return 0 == strcmp(name, descr.name);
+ } );
+ return pdescr == function_descrs_end? 0 : pdescr->token;
+}
+
/*
* For variadic intrinsic functions, ensure all parameters are commensurate.
* Return pointer in 1st inconsistent parameter type.
BLANK_OEOL [[:blank:]]*{EOL}?
-DOTSEP [.][[:space:]]
+DOTSEP [.]+[[:space:]]
DOTEOL [[:blank:]]*[.]{BLANK_EOL}
SKIP [[:blank:]]*SKIP[123][[:blank:]]*[.]?{BLANK_EOL}
PUSH_FILE \f?[#]FILE{SPC}PUSH{SPC}[^\f]+\f
POP_FILE \f?[#]FILE{SPC}POP\f
-LINE_DIRECTIVE [#]line{SPC}[[:alnum:]]+{SPC}[""''].+\n
+LINE_DIRECTIVE ^[#]line{SPC}[[:alnum:]]+{SPC}[""''].+\n
%x procedure_div ident_state addr_of function classify
%x program_id_state comment_entries
}
<ident_state>{
+ ID(ENTIFICATION)?{SPC}DIVISION { myless(0); yy_pop_state(); }
AS{SPC}[""] { yy_push_state(quoted2); return AS; }
AS{SPC}[''] { yy_push_state(quoted1); return AS; }
IS { pop_return IS; }
return typed_name(yytext);
}
+ /* figurative constants that are otherwise matched as names */
+
+ZEROE?S?/{OSPC}{DOTSEP} { return ZERO; }
+SPACES?/{OSPC}{DOTSEP} { yylval.string = NULL; return SPACES; }
+QUOTES?/{OSPC}{DOTSEP} { return QUOTES; }
+NULLS?/{OSPC}{DOTSEP} { return NULLS; }
+LOW-VALUES?/{OSPC}{DOTSEP} { return LOW_VALUES; }
+HIGH-VALUES?/{OSPC}{DOTSEP} { return HIGH_VALUES; }
+
BINARY { return BINARY; }
CLASSIFICATION { return CLASSIFICATION; }
CYCLE { return CYCLE; }
ALTERNATE { return ALTERNATE; }
ALTER { return ALTER; }
ALSO { return ALSO; }
-ALPHABET { return ALPHABET; }
-ALPHABETIC { return ALPHABETIC; }
+
+ALPHABET { return ALPHABET; }
+ALPHABETIC { return ALPHABETIC; }
ALPHABETIC-LOWER { return ALPHABETIC_LOWER; }
ALPHABETIC-UPPER { return ALPHABETIC_UPPER; }
ALPHANUMERIC { return ALPHANUMERIC; }
<name_state>{
^[[:blank:]]+
^{BLANK_EOL}
+ {NAME} |
{NAME}/{OSPC}[.] { yy_pop_state();
yylval.string = xstrdup(yytext); return NAME; }
- {NAME} { yy_pop_state();
- yylval.string = xstrdup(yytext); return NAME; }
Z?[''] { yylval.literal.set_prefix(yytext, yyleng-1);
yy_push_state(quoted1); }
{GREATER_THAN}{SPC}{OR_EQUAL}/[[:space:]] { return GE; }
{GREATER_THAN} { return '>'; }
- {ISNT}{SPC}">=" { return '<'; }
- {ISNT}{SPC}">" { return LE; }
- {ISNT}{SPC}"=" { return NE; }
- {ISNT}{SPC}"<" { return GE; }
- {ISNT}{SPC}"<=" { return '>'; }
+ {ISNT}{OSPC}">=" { verify_ws(yytext[yyleng - 3]); return '<'; }
+ {ISNT}{OSPC}">" { verify_ws(yytext[yyleng - 2]); return LE; }
+ {ISNT}{OSPC}"=" { verify_ws(yytext[yyleng - 2]); return NE; }
+ {ISNT}{OSPC}"<" { verify_ws(yytext[yyleng - 2]); return GE; }
+ {ISNT}{OSPC}"<=" { verify_ws(yytext[yyleng - 3]); return '>'; }
{ISNT}{SPC}GREATER{SPC}(THAN)?{SPC}{OR_EQUAL}/[[:space:]] { return '<'; }
{ISNT}{SPC}GREATER{SPC}(THAN)? { return LE; }
{ISNT}{SPC}LESS{SPC}(THAN)? { return GE; }
{ISNT}{SPC}LESS{SPC}(THAN)?{SPC}{OR_EQUAL}/[[:space:]] { return '>'; }
- [*]{2}{SPC}[+] { return POW; }
- "**" { return POW; }
+ [*]{2} { return POW; }
+
+ /*
+ * "A boolean operator specifies the type of boolean operation to be performed
+ * on one or two operands, for a unary operator or binary operator,
+ * respectively."
+ * Binary boolean operators
+ * B-AND B-OR B-XOR
+ * Unary boolean operator
+ * B-NOT
+ * Boolean shift operators
+ * B-SHIFT-L B-SHIFT-LC B-SHIFT-R B-SHIFT-RC
+ */
+
+B-AND
+B-OR
+B-XOR
+B-NOT
+B-SHIFT-L
+B-SHIFT-LC
+B-SHIFT-R
+B-SHIFT-RC
+
}
<procedure_div>{
(ID|IDENTIFICATION|ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION {
- myless(0); yy_pop_state(); }
+ myless(0); BEGIN(INITIAL); }
+ PROGRAM-ID{OSPC}{DOTSEP} { myless(0); BEGIN(INITIAL); }
EXIT{SPC}/(PROGRAM|SECTION|PARAGRAPH|PERFORM) {
return EXIT; }
DELIMITER { return DELIMITER; }
ENVIRONMENT { return ENVIRONMENT; }
+ /* After name state, pop out of procedure_div state. */
END{SPC}PROGRAM { yy_push_state(name_state);
return program_level() > 1?
END_SUBPROGRAM : END_PROGRAM; }
SECTION{OSPC}[.]{SPC}/USE[[:space:]] { yylval.string = NULL; return SECTION; }
- {NAME}{OSPC}[.]({SPC}(EJECT|SKIP[123]))*{SPC}EXIT{OSPC}/{DOTSEP} {
+ [.]({SPC}(EJECT|SKIP[123]))*{SPC}EXIT{OSPC}/{DOTSEP} {
// EXIT format-1 is a "continue" statement
- yylval.string = xstrdup(yytext);
- auto p = strchr(yylval.string, '.');
- assert(p);
- assert( ISSPACE(p[1]) );
- *p = '\0';
- while( p > yylval.string && ISSPACE(p[-1]) ) {
- *--p = '\0';
- }
-
- int token;
- if( 0 != (token = binary_integer_usage(yylval.string)) )return token;
- if( 0 != (token = keyword_tok(yylval.string)) ) return token;
- if( is_integer_token() ) return numstr_of(yylval.string);
- return typed_name(yylval.string);
}
{NAME}/{OSPC}{DOTSEP} {
assert(YY_START == procedure_div);
}
return token;
}
- [.][[:blank:].]+ { return '.'; }
+ [.]+[[:blank:].]+ { return '.'; }
}
<exception>{
}
<*>{
- {PUSH_FILE} {
- yy_set_bol(true);
- auto top_file = cobol_lineno_save();
- if( top_file ) {
- if( yy_flex_debug ) dbgmsg(" saving line %4d of %s",
- yylineno, top_file);
- }
- // "\f#file push <name>": name starts at offset 13.
- char *filename = xstrdup(yytext);
- filename[yyleng - 1] = '\0'; // kill the trailing formfeed
- filename += 12;
- if( yytext[0] != '\f' ) {
- dbgmsg("logic warning: filename was adjusted to %s", --filename);
+ {PUSH_FILE} {
+ yy_set_bol(true);
+ auto top_file = cobol_lineno(yylineno);
+ if( top_file ) {
+ if( yy_flex_debug ) dbgmsg(" saving line %4d of %s",
+ yylineno, top_file);
+ }
+ // "\f#file push <name>": name starts at offset 13.
+ char *filename = xstrdup(yytext);
+ filename[yyleng - 1] = '\0'; // kill the trailing formfeed
+ filename += 12;
+ if( yytext[0] != '\f' ) {
+ dbgmsg("logic warning: filename was adjusted to %s",
+ --filename);
+ }
+ input_file_status.enter(filename);
+ yylineno = 1;
+ reset_location();
+ }
+
+ {POP_FILE} {
+ yy_set_bol(true);
+ input_file_status.leave();
+ yylineno = cobol_lineno();
}
- input_file_status.enter(filename);
- }
-
- {POP_FILE}{OSPC} {
- yy_set_bol(true);
- input_file_status.leave();
- }
- {LINE_DIRECTIVE} { cobol_fileline_set(yytext); }
+ {LINE_DIRECTIVE} {
+ yylineno = cobol_fileline_set(yytext);
+ reset_location();
+ }
}
<*>OR { return OR; }
<*>AND { return AND; }
<*>{DOTSEP}[[:blank:].]+$ { return '.'; }
-<*>[*/+-]{SPC}[+] { return *yytext; }
<*>[().=*/+&-] { return *yytext; }
<*>[[:blank:]]+
<*>\r?\n
<*>{
ACCEPT { return ACCEPT; }
ACCESS { return ACCESS; }
- ADD { return ADD; }
+ ADD { return ADD; }
ADDRESS { return ADDRESS; }
ADVANCING { return ADVANCING; }
- AFTER { return AFTER; }
- ALL { return ALL; }
+ AFTER { return AFTER; }
+ ALL { return ALL; }
ALLOCATE { return ALLOCATE; }
ALPHABET { return ALPHABET; }
ALPHABETIC { return ALPHABETIC; }
ALPHABETIC-LOWER { return ALPHABETIC_LOWER; }
ALPHABETIC-UPPER { return ALPHABETIC_UPPER; }
- ALPHANUMERIC { return ALPHANUMERIC; }
+ ALPHANUMERIC { return ALPHANUMERIC; }
ALPHANUMERIC-EDITED { return ALPHANUMERIC_EDITED; }
- ALSO { return ALSO; }
+ ALSO { return ALSO; }
ALTERNATE { return ALTERNATE; }
- AND { return AND; }
- ANY { return ANY; }
+ AND { return AND; }
+ ANY { return ANY; }
ANYCASE { return ANYCASE; }
- ARE { return ARE; }
- AREA { return AREA; }
- AREAS { return AREAS; }
- AS { return AS; }
+ ARE { return ARE; }
+ AREA { return AREA; }
+ AREAS { return AREAS; }
+ AS { return AS; }
ASCENDING { return ASCENDING; }
- ASSIGN { return ASSIGN; }
- AT { return AT; }
- BASED { return BASED; }
+ ASSIGN { return ASSIGN; }
+ AT { return AT; }
+ BASED { return BASED; }
BEFORE { return BEFORE; }
BINARY { return BINARY; }
- BIT { return BIT; }
- BLANK { return BLANK; }
- BLOCK { return BLOCK_kw; }
+ BIT { return BIT; }
+ BLANK { return BLANK; }
+ BLOCK { return BLOCK_kw; }
BOTTOM { return BOTTOM; }
- BY { return BY; }
- CALL { return CALL; }
+ BY { return BY; }
+ CALL { return CALL; }
CANCEL { return CANCEL; }
- CF { return CF; }
- CH { return CH; }
+ CF { return CF; }
+ CH { return CH; }
CHARACTER { return CHARACTER; }
CHARACTERS { return CHARACTERS; }
- CLASS { return CLASS; }
- CLOSE { return CLOSE; }
- CODE { return CODE; }
- COMMA { return COMMA; }
+ CLASS { return CLASS; }
+ CLOSE { return CLOSE; }
+ CODE { return CODE; }
+ COMMA { return COMMA; }
COMMIT { return COMMIT; }
COMMON { return COMMON; }
CONDITION { return CONDITION; }
CONTROL { return CONTROL; }
CONTROLS { return CONTROLS; }
CONVERTING { return CONVERTING; }
- COPY { return COPY; }
- COUNT { return COUNT; }
+ COPY { return COPY; }
+ COUNT { return COUNT; }
CURRENCY { return CURRENCY; }
- DATA { return DATA; }
- DATE { return DATE; }
- DAY { return DAY; }
+ DATA { return DATA; }
+ DATE { return DATE; }
+ DAY { return DAY; }
DAY-OF-WEEK { return DAY_OF_WEEK; }
- DE { return DE; }
+ DE { return DE; }
DECIMAL-POINT { return DECIMAL_POINT; }
DECLARATIVES { return DECLARATIVES; }
DEFAULT { return DEFAULT; }
DETAIL { return DETAIL; }
DISPLAY { return DISPLAY; }
DIVIDE { return DIVIDE; }
- DOWN { return DOWN; }
+ DOWN { return DOWN; }
DUPLICATES { return DUPLICATES; }
DYNAMIC { return DYNAMIC; }
- EC { return EC; }
- ELSE { return ELSE; }
- END { return END; }
+ EC { return EC; }
+ ELSE { return ELSE; }
+ END { return END; }
END-ACCEPT { return END_ACCEPT; }
END-ADD { return END_ADD; }
END-CALL { return END_CALL; }
END-SUBTRACT { return END_SUBTRACT; }
END-WRITE { return END_WRITE; }
ENVIRONMENT { return ENVIRONMENT; }
- EQUAL { return EQUAL; }
- ERROR { return ERROR; }
+ EQUAL { return EQUAL; }
+ ERROR { return ERROR; }
EVALUATE { return EVALUATE; }
EXCEPTION { return EXCEPTION; }
- EXIT { return EXIT; }
+ EXIT { return EXIT; }
EXTEND { return EXTEND; }
EXTERNAL { return EXTERNAL; }
- FD { return FD; }
- FINAL { return FINAL; }
+ FD { return FD; }
+ FINAL { return FINAL; }
FINALLY { return FINALLY; }
- FIRST { return FIRST; }
+ FIRST { return FIRST; }
FOOTING { return FOOTING; }
- FOR { return FOR; }
- FREE { return FREE; }
- FROM { return FROM; }
+ FOR { return FOR; }
+ FREE { return FREE; }
+ FROM { return FROM; }
FUNCTION { return FUNCTION; }
GENERATE { return GENERATE; }
GIVING { return GIVING; }
GLOBAL { return GLOBAL; }
- GO { return GO; }
+ GO { return GO; }
GOBACK { return GOBACK; }
- GROUP { return GROUP; }
+ GROUP { return GROUP; }
HEADING { return HEADING; }
- IDENTIFICATION { return IDENTIFICATION_DIV; }
- IF { return IF; }
- IN { return IN; }
- INDEX { return INDEX; }
+ IF { return IF; }
+ IN { return IN; }
+ INDEX { return INDEX; }
INDEXED { return INDEXED; }
INDICATE { return INDICATE; }
INITIAL { return INITIAL; }
INITIALIZE { return INITIALIZE; }
INITIATE { return INITIATE; }
- INPUT { return INPUT; }
+ INPUT { return INPUT; }
INSPECT { return INSPECT; }
INTERFACE { return INTERFACE; }
- INTO { return INTO; }
+ INTO { return INTO; }
INVOKE { return INVOKE; }
- IS { return IS; }
- KEY { return KEY; }
- LAST { return LAST; }
+ IS { return IS; }
+ KEY { return KEY; }
+ LAST { return LAST; }
LEADING { return LEADING; }
- LEFT { return LEFT; }
+ LEFT { return LEFT; }
LENGTH { return LENGTH; }
- LIMIT { return LIMIT; }
+ LIMIT { return LIMIT; }
LIMITS { return LIMITS; }
LINAGE { return LINAGE; }
- LINE { return LINE; }
+ LINE { return LINE; }
LINE-COUNTER { return LINE_COUNTER; }
- LINES { return LINES; }
+ LINES { return LINES; }
LINKAGE { return LINKAGE; }
LOCAL-STORAGE { return LOCAL_STORAGE; }
LOCALE { return LOCALE; }
LOCATION { return LOCATION; }
- LOCK { return LOCK; }
- MERGE { return MERGE; }
- MODE { return MODE; }
- MOVE { return MOVE; }
+ LOCK { return LOCK; }
+ MERGE { return MERGE; }
+ MODE { return MODE; }
+ MOVE { return MOVE; }
MULTIPLY { return MULTIPLY; }
NATIONAL { return NATIONAL; }
NATIONAL-EDITED { return NATIONAL_EDITED; }
NATIVE { return NATIVE; }
NEGATIVE { return NEGATIVE; }
NESTED { return NESTED; }
- NEXT { return NEXT; }
- NO { return NO; }
- NOT { return NOT; }
+ NEXT { return NEXT; }
+ NO { return NO; }
+ NOT { return NOT; }
NUMBER { return NUMBER; }
NUMERIC { return NUMERIC; }
NUMERIC-EDITED { return NUMERIC_EDITED; }
OCCURS { return OCCURS; }
- OF { return OF; }
- OFF { return OFF; }
+ OF { return OF; }
+ OFF { return OFF; }
OMITTED { return OMITTED; }
- ON { return ON; }
- OPEN { return OPEN; }
+ ON { return ON; }
+ OPEN { return OPEN; }
OPTIONAL { return OPTIONAL; }
OPTIONS { return OPTIONS; }
- OR { return OR; }
- ORDER { return ORDER; }
- ORGANIZATION { return ORGANIZATION; }
- OTHER { return OTHER; }
+ OR { return OR; }
+ ORDER { return ORDER; }
+ ORGANI[SZ]ATION { return ORGANIZATION; }
+ OTHER { return OTHER; }
OUTPUT { return OUTPUT; }
OVERFLOW { return OVERFLOW_kw; }
OVERRIDE { return OVERRIDE; }
PACKED-DECIMAL { return PACKED_DECIMAL; }
- PAGE { return PAGE; }
+ PAGE { return PAGE; }
PAGE-COUNTER { return PAGE_COUNTER; }
PERFORM { return PERFORM; }
- PF { return PF; }
- PH { return PH; }
- PIC { return PIC; }
+ PF { return PF; }
+ PH { return PH; }
+ PIC { return PIC; }
PICTURE { return PICTURE; }
- PLUS { return PLUS; }
+ PLUS { return PLUS; }
POINTER { return POINTER; }
POSITIVE { return POSITIVE; }
PROCEDURE { return PROCEDURE; }
PROPERTY { return PROPERTY; }
PROTOTYPE { return PROTOTYPE; }
QUOTES { return QUOTES; }
- RAISE { return RAISE; }
+ RAISE { return RAISE; }
RAISING { return RAISING; }
RANDOM { return RANDOM; }
- RD { return RD; }
- READ { return READ; }
+ RD { return RD; }
+ READ { return READ; }
RECORD { return RECORD; }
RECORDS { return RECORDS; }
REDEFINES { return REDEFINES; }
- REEL { return REEL; }
+ REEL { return REEL; }
REFERENCE { return REFERENCE; }
RELATIVE { return RELATIVE; }
RELEASE { return RELEASE; }
REPORTS { return REPORTS; }
REPOSITORY { return REPOSITORY; }
RESERVE { return RESERVE; }
- RESET { return RESET; }
+ RESET { return RESET; }
RESUME { return RESUME; }
RETURN { return RETURN; }
RETURNING { return RETURNING; }
REWIND { return REWIND; }
REWRITE { return REWRITE; }
- RF { return RF; }
- RH { return RH; }
- RIGHT { return RIGHT; }
+ RF { return RF; }
+ RH { return RH; }
+ RIGHT { return RIGHT; }
ROUNDED { return ROUNDED; }
- RUN { return RUN; }
- SAME { return SAME; }
+ RUN { return RUN; }
+ SAME { return SAME; }
SCREEN { return SCREEN; }
- SD { return SD; }
+ SD { return SD; }
SEARCH { return SEARCH; }
SECTION { return SECTION; }
SELECT { return SELECT; }
SEPARATE { return SEPARATE; }
SEQUENCE { return SEQUENCE; }
SEQUENTIAL { return SEQUENTIAL; }
- SET { return SET; }
+ SET { return SET; }
SHARING { return SHARING; }
- SIGN { return SIGN; }
- SIZE { return SIZE; }
- SORT { return SORT; }
+ SIGN { return SIGN; }
+ SIZE { return SIZE; }
+ SORT { return SORT; }
SORT-MERGE { return SORT_MERGE; }
SOURCE { return SOURCE; }
- SPACE { return SPACE; }
+ SPACE { return SPACE; }
SPACES { return SPACES; }
SPECIAL-NAMES { return SPECIAL_NAMES; }
STANDARD { return STANDARD; }
STANDARD-1 { return STANDARD_1; }
- START { return START; }
+ START { return START; }
STATUS { return STATUS; }
- STOP { return STOP; }
+ STOP { return STOP; }
SUBTRACT { return SUBTRACT; }
- SUM { return SUM; }
+ SUM { return SUM; }
SUPPRESS { return SUPPRESS; }
SYMBOLIC { return SYMBOLIC; }
TALLYING { return TALLYING; }
TERMINATE { return TERMINATE; }
- TEST { return TEST; }
- THAN { return THAN; }
- THEN { return THEN; }
- THRU { return THRU; }
- TIME { return TIME; }
- TIMES { return TIMES; }
- TO { return TO; }
- TOP { return TOP; }
+ TEST { return TEST; }
+ THAN { return THAN; }
+ THEN { return THEN; }
+ THRU { return THRU; }
+ TIME { return TIME; }
+ TIMES { return TIMES; }
+ TO { return TO; }
+ TOP { return TOP; }
TRAILING { return TRAILING; }
- TYPE { return TYPE; }
+ TYPE { return TYPE; }
TYPEDEF { return TYPEDEF; }
- UNIT { return UNIT; }
- UNTIL { return UNTIL; }
- UP { return UP; }
- UPON { return UPON; }
- USAGE { return USAGE; }
- USE { return USE; }
- USING { return USING; }
- VALUE { return VALUE; }
+ UNIT { return UNIT; }
+ UNTIL { return UNTIL; }
+ UP { return UP; }
+ UPON { return UPON; }
+ USAGE { return USAGE; }
+ USE { return USE; }
+ USING { return USING; }
+ VALUE { return VALUE; }
VARYING { return VARYING; }
- WHEN { return WHEN; }
- WITH { return WITH; }
+ WHEN { return WHEN; }
+ WITH { return WITH; }
WORKING-STORAGE { return WORKING_STORAGE; }
- WRITE { return WRITE; }
+ WRITE { return WRITE; }
ZERO |
ZEROES |
- ZEROS { return ZERO; }
+ ZEROS { return ZERO; }
}
<*>{
return NO_CONDITION;
}
-<<EOF>> {
-
- if( YY_START == quoted1 || YY_START == quoted2 ) {
+<quoted1,quoted2>{
+ <<EOF>> {
error_msg(yylloc, "syntax error: unterminated string %<%s%>",
tmpstring);
return NO_CONDITION;
- }
- yypop_buffer_state();
-
- if ( !YY_CURRENT_BUFFER ) {
- return 0;
- }
-
- if( ! wait_for_the_child() ) {
- yyterminate();
- }
- cobol_filename_restore();
- parser_leave_file();
-
- if( yydebug ) yywarn("resume parsing '%s'", cobol_filename());
- yy_set_bol(true);
- }
+ }
+}
%%
public:
enter_leave_t() : entering(NULL), leaving(NULL), filename(NULL) {}
enter_leave_t( parser_enter_file_f *entering, const char *filename )
- : entering(entering), leaving(NULL), filename(filename) {}
+ : entering(entering), leaving(NULL), filename(filename)
+ {}
explicit enter_leave_t(parser_leave_file_f *leaving)
: entering(NULL), leaving(leaving), filename(NULL) {}
- void notify( unsigned int newlines = 0 ) {
+ void notify() {
if( entering ) {
cobol_filename(filename, 0);
if( yy_flex_debug ) dbgmsg("starting line %4d of %s",
gcc_assert(leaving == NULL);
}
if( leaving ) {
- auto name = cobol_filename_restore();
- yylineno += newlines;
+ cobol_filename_restore();
if( yy_flex_debug ) dbgmsg("resuming line %4d of %s",
- yylineno, name? name : "<none>");
+ yylineno, cobol_filename());
leaving();
gcc_assert(entering == NULL);
}
static class input_file_status_t {
std::queue <enter_leave_t> inputs;
- unsigned int trailing_newlines = 0;
public:
void enter(const char *filename) {
inputs.push( enter_leave_t(parser_enter_file, filename) );
}
void leave() {
- // Add the number of newlines following the POP to yylineno when it's restored.
- trailing_newlines = std::count(yytext, yytext + yyleng, '\n');
- if( trailing_newlines && yy_flex_debug )
- dbgmsg("adding %u lines after POP", trailing_newlines);
inputs.push( enter_leave_t(parser_leave_file) );
}
void notify() {
while( ! inputs.empty() ) {
auto enter_leave = inputs.front();
- enter_leave.notify(trailing_newlines);
+ enter_leave.notify();
inputs.pop();
}
}
void input_file_status_notify() { input_file_status.notify(); }
-void cdf_location_set(YYLTYPE loc);
+/*
+ * parse.y and cdf.y each define a 4-integer struct to hold a token's location.
+ * parse.y uses YYLTYPE yylloc;
+ * cdf.y uses YDFLLTYPE ydflloc;
+ *
+ * The structs have identical definitions with different types and of course
+ * names. We define "conversion" between them for convenience.
+ *
+ * Each parser expects its location value to be updated whenever it calls
+ * yylex(). Therefore, here in the lexer we set both locations as each token
+ * is scanned, so that both parsers see the same location.
+ */
+static YDFLTYPE
+ydfltype_of( const YYLTYPE& loc ) {
+ YDFLTYPE output {
+ loc.first_line, loc.first_column,
+ loc.last_line, loc.last_column };
+ return output;
+}
+/*
+ * After the input filename and yylineno are set, update the location of the
+ * scanned token.
+ */
static void
-update_location() {
+update_location( const YYLTYPE *ploc = nullptr ) {
YYLTYPE loc = {
yylloc.last_line, yylloc.last_column,
yylineno, yylloc.last_column + yyleng
};
+ if( ploc ) loc = *ploc;
- auto nline = std::count(yytext, yytext + yyleng, '\n');
- if( nline ) {
- const char *p = static_cast<char*>(memrchr(yytext, '\n', yyleng));
+ const char *p = static_cast<char*>(memrchr(yytext, '\n', yyleng));
+ if( p ) {
loc.last_column = (yytext + yyleng) - p;
}
yylloc = loc;
- cdf_location_set(loc);
- location_dump(__func__, __LINE__, "yylloc", yylloc);
+ ydflloc = ydfltype_of(yylloc);
+
+ dbgmsg(" SC: %s location (%d,%d) to (%d,%d)",
+ start_condition_is(),
+ yylloc.first_line, yylloc.first_column,
+ yylloc.last_line, yylloc.last_column);
}
+static void
+reset_location() {
+ static const YYLTYPE loc { yylineno, 1, yylineno, 1 };
+ update_location(&loc);
+}
+
+#define YY_USER_ACTION update_location();
+
static void
trim_location( int nkeep) {
gcc_assert( 0 <= nkeep && nkeep <= yyleng );
#define YY_USER_INIT do { \
static YYLTYPE ones = {1,1, 1,1}; \
- yylloc = ones; \
+ yylloc = ones; \
+ ydflloc = ydfltype_of(yylloc); \
} while(0)
/*
* updates neither yylval nor yylloc. That job is left to the actions.
*
* The parser relies on yylex to set yylval and yylloc each time it is
- * called. It apparently maintains a separate copy for each term, and uses
+ * called. It maintains a separate copy for each term, and uses
* YYLLOC_DEFAULT() to update the location of nonterminals.
*/
#define YY_DECL int lexer(void)
-#define YY_USER_ACTION \
- update_location(); \
- if( yy_flex_debug ) dbgmsg("SC: %s", start_condition_is() );
-
# define YY_INPUT(buf, result, max_size) \
{ \
if( 0 == (result = lexer_input(buf, max_size, yyin)) ) \
return p->second.token;
}
+static void
+verify_ws( const YYLTYPE& loc, const char input[], char ch ) {
+ if( ! fisspace(ch) ) {
+ if( ! (dialect_mf() || dialect_gnu()) ) {
+ dialect_error(loc, "separator space required in %qs", input);
+ }
+ }
+}
+#define verify_ws(C) verify_ws(yylloc, yytext, C)
+
int
binary_integer_usage_of( const char name[] ) {
cbl_name_t uname = {};
#define pop_return yy_pop_state(); return
-static bool
-wait_for_the_child(void) {
- pid_t pid;
- int status;
-
- if( (pid = wait(&status)) == -1 ) {
- yywarn("internal error: no pending child CDF parser process");
- return false;
- }
-
- if( WIFSIGNALED(status) ) {
- yywarn( "process %ld terminated by %s",
- static_cast<long>(pid), strsignal(WTERMSIG(status)) );
- return false;
- }
- if( WIFEXITED(status) ) {
- if( WEXITSTATUS(status) != 0 ) {
- yywarn("process %ld exited with status %d",
- static_cast<long>(pid), status);
- return false;
- }
- }
- if( yy_flex_debug ) {
- yywarn("process %ld exited with status %d",
- static_cast<long>(pid), status);
- }
- return true;
-}
-
static bool is_not = false;
static uint64_t
bool cobol_filename( const char *name );
const char * cobol_filename();
-const char * cobol_fileline_set( const char line[] );
+int cobol_fileline_set( const char line[] );
char *cobol_name_mangler(const char *cobol_name);
static_assert(sizeof(matrix[0]) == COUNT_OF(matrix[0]),
"matrix should be square");
- for( const cbl_field_t *args[] = {tgt, src}, **p=args;
- p < args + COUNT_OF(args); p++ ) {
- auto& f(**p);
- switch(f.type) {
+ for( auto field : { src, tgt } ) {
+ switch(field->type) {
case FldClass:
case FldConditional:
case FldIndex:
case FldForward:
case FldBlob:
default:
- if( sizeof(matrix[0]) < f.type ) {
+ if( sizeof(matrix[0]) < field->type ) {
cbl_internal_error("logic error: MOVE %s %s invalid type:",
- cbl_field_type_str(f.type), f.name);
+ cbl_field_type_str(field->type), field->name);
}
break;
}
ino_t inode;
int lineno;
const char *name;
- const line_map *lines;
input_file_t( const char *name, ino_t inode,
- int lineno=1, const line_map *lines = NULL )
- : inode(inode), lineno(lineno), name(name), lines(lines)
+ int lineno=1 )
+ : inode(inode), lineno(lineno), name(name)
{
if( inode == 0 ) inode_set();
}
}
return false;
}
+
+ // Look down into the stack. peek(0) == top()
+ const input_file_t& peek( size_t n ) const {
+ gcc_assert( n < size() );
+ return c.at(size() - ++n);
+ }
void option( int opt ) { // capture other preprocessor options eventually
assert(opt == 'M');
}
linemap_add(line_table, LC_ENTER, sysp, name, 1);
input_filename_vestige = name;
- bool pushed = input_filenames.push( input_file_t(name, inode, 1, lines) );
- input_filenames.top().lineno = yylineno = 1;
+ bool pushed = input_filenames.push( input_file_t(name, inode, 1) );
return pushed;
}
const char *
-cobol_lineno_save() {
+cobol_lineno( int lineno ) {
if( input_filenames.empty() ) return NULL;
auto& input( input_filenames.top() );
- input.lineno = yylineno;
+ input.lineno = lineno;
return input.name;
}
+/*
+ * This function is called from the scanner, usually when a copybook is on top
+ * of the input stack, before the parser retrieves the token and resets the
+ * current filename. For that reason, we normaly want to line number of the
+ * file that is about to become the current one, which is the one behind top().
+ *
+ * If somehow we arrive here when there is nothing underneath, we return the
+ * current line nubmer, or zero if there's no input. The only consequence is
+ * that the reported line number might be wrong.
+ */
+int
+cobol_lineno() {
+ if( input_filenames.empty() ) return 0;
+ size_t n = input_filenames.size() < 2? 0 : 1;
+ const auto& input( input_filenames.peek(n) );
+ return input.lineno;
+}
+
const char *
cobol_filename() {
return input_filenames.empty()? input_filename_vestige : input_filenames.top().name;
}
-const char *
+void
cobol_filename_restore() {
assert(!input_filenames.empty());
const input_file_t& top( input_filenames.top() );
input_filename_vestige = top.name;
input_filenames.pop();
- if( input_filenames.empty() ) return NULL;
+ if( input_filenames.empty() ) return;
auto& input = input_filenames.top();
- input.lines = linemap_add(line_table, LC_LEAVE, sysp, NULL, 0);
-
- yylineno = input.lineno;
- return input.name;
+ linemap_add(line_table, LC_LEAVE, sysp, NULL, 0);
}
static location_t token_location;
+location_t location_from_lineno() { return token_location; }
+
template <typename LOC>
static void
gcc_location_set_impl( const LOC& loc ) {
ERROR_MSG_BODY
}
-void
-cdf_location_set(YYLTYPE loc) {
- extern YDFLTYPE ydflloc;
-
- ydflloc.first_line = loc.first_line;
- ydflloc.first_column = loc.first_column;
- ydflloc.last_line = loc.last_line;
- ydflloc.last_column = loc.last_column;
-}
-
void
yyerror( const char gmsgid[], ... ) {
temp_loc_t looker;
static inline size_t
matched_length( const regmatch_t& rm ) { return rm.rm_eo - rm.rm_so; }
-const char *
+int
cobol_fileline_set( const char line[] ) {
static const char pattern[] = "#line +([[:alnum:]]+) +[\"']([^\"']+). *\n";
static const int cflags = REG_EXTENDED | REG_ICASE;
if( (erc = regcomp(&re, pattern, cflags)) != 0 ) {
regerror(erc, &re, regexmsg, sizeof(regexmsg));
dbgmsg( "%s:%d: could not compile regex: %s", __func__, __LINE__, regexmsg );
- return line;
+ return 0;
}
preg = &re;
}
if( erc != REG_NOMATCH ) {
regerror(erc, preg, regexmsg, sizeof(regexmsg));
dbgmsg( "%s:%d: could not compile regex: %s", __func__, __LINE__, regexmsg );
- return line;
+ return 0;
}
error_msg(yylloc, "invalid %<#line%> directive: %s", line );
- return line;
+ return 0;
}
const char
input_file_t input_file( filename, ino_t(0), fileline ); // constructor sets inode
if( input_filenames.empty() ) {
- input_file.lines = linemap_add(line_table, LC_ENTER, sysp, filename, 1);
input_filenames.push(input_file);
}
input_file_t& file = input_filenames.top();
file = input_file;
- yylineno = file.lineno;
- return file.name;
+ return file.lineno;
}
//#define TIMING_PARSE
bool fisspace(int c)
{
return ISSPACE(c);
- };
+ }
int ftolower(int c)
{
return TOLOWER(c);
bool fisprint(int c)
{
return ISPRINT(c);
- };
+ }
// 8.9 Reserved words
static const std::set<std::string> reserved_words = {
void cobol_set_pp_option(int opt);
-const char * cobol_filename_restore();
-const char * cobol_lineno_save();
+void cobol_filename_restore();
+const char * cobol_lineno( int );
+int cobol_lineno();
unsigned long gb4( size_t input );
projects / thirdparty / gcc.git / commitdiff
