# First, files needed for parsing:
cobol/parse.cc: cobol/parse.y
+ $(BISON) --version | grep ^bison
$(BISON) -o $@ $(YFLAGS) \
--defines=cobol/parse.h \
--report-file=cobol/parser.out $<
const char * cobol_filename();
+#if ! defined(ATTRIBUTE_GCOBOL_DIAG)
+#define ATTRIBUTE_GCOBOL_DIAG(a, b)
+#endif
+#if ! defined(ATTRIBUTE_PRINTF_1)
+#define ATTRIBUTE_PRINTF_1
+#endif
+#if ! defined(ATTRIBUTE_PRINTF_3)
+#define ATTRIBUTE_PRINTF_3
+#endif
+
/*
- * These are user-facing messages. They go through the gcc
- * diagnostic framework and use text that can be localized.
+ * Enumerations do not depend on anything else.
*/
-void yyerror( const char fmt[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2);
-/* Location type. Borrowed from parse.h as generated by Bison. */
-#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
-typedef struct YYLTYPE YYLTYPE;
-struct YYLTYPE
-{
- int first_line;
- int first_column;
- int last_line;
- int last_column;
+enum cbl_gcobol_feature_t {
+ feature_gcc_e = 0x00,
+ feature_internal_ebcdic_e = 0x01,
+ feature_embiggen_e = 0x02, // widen numeric that redefine POINTER
};
-# define YYLTYPE_IS_DECLARED 1
-# define YYLTYPE_IS_TRIVIAL 1
-const YYLTYPE& cobol_location();
-#endif
+bool cobol_gcobol_feature_set( cbl_gcobol_feature_t gcobol_feature,
+ bool on = true );
-#if ! defined YDFLTYPE && ! defined YDFLTYPE_IS_DECLARED
-typedef struct YDFLTYPE YDFLTYPE;
-struct YDFLTYPE
-{
- int first_line;
- int first_column;
- int last_line;
- int last_column;
+enum cbl_call_convention_t {
+ cbl_call_verbatim_e = 'V',
+ cbl_call_cobol_e = 'N', // native
};
-# define YDFLTYPE_IS_DECLARED 1
-# define YDFLTYPE_IS_TRIVIAL 1
-#endif
+void current_call_convention( cbl_call_convention_t convention);
+cbl_call_convention_t current_call_convention();
+
+
+/*
+ * CDF state does not require types that would be defined in another file.
+ */
+void cdf_push();
+void cdf_push_call_convention();
+void cdf_push_current_tokens();
+void cdf_push_dictionary();
+void cdf_push_enabled_exceptions();
+void cdf_push_source_format();
+
+void cdf_pop();
+void cdf_pop_call_convention();
+void cdf_pop_current_tokens();
+void cdf_pop_dictionary();
+void cdf_pop_source_format();
+void cdf_pop_enabled_exceptions();
+
+size_t current_program_index();
+
+/*
+ * These are user-facing messages. They go through the gcc
+ * diagnostic framework and use text that can be localized.
+ */
+void yyerror( const char fmt[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2);
-struct cbl_loc_t {
+struct cbl_loc_base_t {
int first_line;
int first_column;
int last_line;
int last_column;
+};
+struct cbl_loc_t : public cbl_loc_base_t {
- cbl_loc_t()
- : first_line(0)
- , first_column(0)
- , last_line(0)
- , last_column(0)
+ cbl_loc_t() : cbl_loc_base_t{}
{}
- cbl_loc_t( const YYLTYPE& loc )
- : first_line(loc.first_line)
- , first_column(loc.first_column)
- , last_line(loc.last_line)
- , last_column(loc.last_column)
+ cbl_loc_t( int first_line, int first_column,
+ int last_line, int last_column )
+ : cbl_loc_base_t {
+ first_line , first_column,
+ last_line, last_column
+ }
{}
-
- operator YYLTYPE() const { // cppcheck-suppress syntaxError
- return { first_line, first_column, last_line, last_column };
- }
+ cbl_loc_t( const cbl_loc_base_t& base ) : cbl_loc_base_t(base)
+ {}
+#if 0
+ cbl_loc_t( int first_line, int first_column,
+ int last_line, int last_column )
+ : first_line(first_line)
+ , first_column(first_column)
+ , last_line(last_line)
+ , last_column(last_column)
+ {}
+#endif
};
+const cbl_loc_t& cobol_location();
+
/*
* Naming Convention: Names end with a letter that indicates
* their kind:
DiagDiagDiag // always last
};
+void cbl_err(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2);
+void cbl_errx(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2);
+
bool cbl_message( cbl_diag_id_t id, const char msg[], ... )
ATTRIBUTE_GCOBOL_DIAG(2, 3);
bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char msg[], ... )
ATTRIBUTE_GCOBOL_DIAG(3, 4);
+[[noreturn]] void cbl_internal_error(const char *format_string, ...)
+ ATTRIBUTE_GCOBOL_DIAG(1, 2);
+
bool
dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok = true );
// Diagnostic format specifiers are documented in gcc/pretty-print.cc
// an error at a location, called from the parser for semantic errors
-void error_msg( const YYLTYPE& loc, const char gmsgid[], ... )
+void error_msg( const cbl_loc_t& loc, const char gmsgid[], ... )
+ ATTRIBUTE_GCOBOL_DIAG(2, 3);
+
+void error_msg( const cbl_loc_t& loc, const char gmsgid[], ... )
ATTRIBUTE_GCOBOL_DIAG(2, 3);
bool
-warn_msg( const YYLTYPE& loc, const char gmsgid[], ... )
+warn_msg( const cbl_loc_t& loc, const char gmsgid[], ... )
ATTRIBUTE_GCOBOL_DIAG(2, 3);
// an error that uses token_location, not yylloc
ATTRIBUTE_GCOBOL_DIAG(2, 3); // warning
void cbl_unimplemented(const char *gmsgid, ...)
ATTRIBUTE_GCOBOL_DIAG(1, 2); // error
-void cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... )
+void cbl_unimplemented_at( const cbl_loc_t& loc, const char *gmsgid, ... )
ATTRIBUTE_GCOBOL_DIAG(2, 3);
/*
*/
void dbgmsg( const char fmt[], ... ) ATTRIBUTE_PRINTF_1;
-void gcc_location_set( const YYLTYPE& loc );
+void gcc_location_set( const cbl_loc_t& loc );
void gcc_location_dump();
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
+
%{
-#include "cobol-system.h"
-#include <coretypes.h>
-#include <tree.h>
+#include <cassert>
+#include <cctype>
+#include <cstdint>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
-#undef yy_flex_debug
+#include <algorithm>
+#include <deque>
+#include <list>
+#include <map>
+#include <iostream>
+#include <string>
+#include <vector>
+
+#include <unistd.h>
+
+#define HAVE_DECL_BASENAME 1
+#include <libiberty.h>
+
+#define CDF_Y
-#include "../../libgcobol/ec.h"
-#include "../../libgcobol/common-defs.h"
-#include "util.h"
#include "cbldiag.h"
-#include "symbols.h"
#include "copybook.h"
+#include "../../libgcobol/ec.h"
+#include "../../libgcobol/common-defs.h"
#include "../../libgcobol/exceptl.h"
#include "exceptg.h"
+// Quell warning: variable yynerrs_ set but not used
+#pragma GCC diagnostic ignored "-Wunused-but-set-variable"
+
+std::ostream&
+operator<<( std::ostream& os, cbl_loc_t const& loc ) {
+ os << "("
+ << loc.first_line
+ << ","
+ << loc.first_column
+ << ") to ("
+ << loc.last_line
+ << ","
+ << loc.last_column
+ << ")";
+ return os;
+}
+
+const char * keyword_str( int token );
+
+namespace cdf {
+static int current_token;
+static int used_token( int token ) {
+ dbgmsg("%s: %s", __func__, keyword_str(token));
+ return current_token = token;
+}
+
+int used_token() { return current_token; }
+}
+#define USED_TOKEN(T) cdf::used_token(parser::token::YDF_ ##T)
+
+%}
+
+%code requires {
+ namespace cdf
+ {
+ class parser;
+ }
+}
+
+%code {
+ // https://learnmoderncpp.com/2020/12/17/generating-c-programs-with-flex-and-bison-2/
+ namespace cdf
+ {
+ int cdflex( parser::semantic_type *value, cbl_loc_t *loc );
+ }
+}
+
+%define api.location.type {cbl_loc_t}
+
+%{
#define COUNT_OF(X) (sizeof(X) / sizeof(X[0]))
+int keyword_tok( const char * text, bool include_intrinsics = false );
+
copybook_t copybook;
+std::ostream& operator<<(std::ostream& os, const cbl_loc_t& loc);
+
static inline bool
is_word( int c ) {
- return c == '_' || ISALNUM(c);
+ return c == '_' || ::isalnum(c);
}
static std::pair<long long, bool>
'yynerrs', 'yylval', 'yylloc', 'yychar' and 'yydebug'. [...] The
renamed macros include 'YYSTYPE', 'YYLTYPE', and 'YYDEBUG'" */
-extern int yylineno, yyleng;
+extern int yylineno, yyleng, yydebug;
extern char *yytext;
-static int ydflex(void);
+extern size_t cbl_gcobol_features;
#define PROGRAM current_program_index()
-const YYLTYPE& cobol_location();
-static YYLTYPE location_set( const YYLTYPE& loc );
+const cbl_loc_t& cobol_location();
+static cbl_loc_t location_set( const cbl_loc_t& loc );
void input_file_status_notify();
#define YYLLOC_DEFAULT(Current, Rhs, N) \
%code requires {
#include "cdfval.h"
-
+ struct cbl_file_t;
using std::map;
#pragma GCC diagnostic push
cdfval_t operator/( const cdfval_base_t& lhs, const cdfval_base_t& rhs );
cdfval_t negate( cdfval_base_t lhs );
- cbl_field_t
- cdf_literalize( const cbl_loc_t& loc,
- const std::string& name, const cdfval_t& value, bool init = true );
+ void cdf_unreachable();
+ void cdf_field_add( const cbl_loc_t&, const std::string& name, const cdfval_t& value );
+ cbl_file_t * cdf_file( size_t program, const cbl_name_t name );
+ size_t cdf_file_index( const cbl_file_t *file );
+ const char * cdf_file_name(const cbl_file_t*);
}
%{
std::set<size_t> *files;
}
-%printer { fprintf(yyo, "'%s'", $$? "true" : "false" ); } <boolean>
-%printer { fprintf(yyo, "'%s'", $$ ); } <string>
-%printer { fprintf(yyo, "%s '%s'",
+%printer { fprintf(stderr, "'%s'", $$ ); } <string>
+%printer { fprintf(stderr, "'%s'", $$? "true" : "false" ); } <boolean>
+%printer { fprintf(stderr, "%s '%s'",
keyword_str($$.token),
$$.string? $$.string : "<nil>" ); } <cdfarg>
-/* cppcheck-suppress invalidPrintfArgType_sint */
-%printer { fprintf(yyo, HOST_SIZE_T_PRINT_DEC " '%s'",
- (fmt_size_t)$$.number, $$.string? $$.string : "" ); } <cdfval>
-
+// cppcheck-suppress invalidPrintfArgType_sint
+%printer { fprintf(stderr, "%ld '%s'",
+ (long)$$.number, $$.string? $$.string : "" ); } <cdfval>
+
%type <string> NAME NUMSTR LITERAL PSEUDOTEXT
%type <string> LSUB RSUB SUBSCRIPT
%type <cdfarg> namelit name_any name_one
%left '*' '/'
%right NEG 958
-%define api.prefix {ydf}
+%require "3.8.2" // for C++ output
+%language "c++"
+
+%define api.prefix {cdf}
%define api.token.prefix{YDF_}
%locations
}
;
strings: LITERAL {
+ USED_TOKEN(LITERAL);
display_msg = xstrdup($1);
}
| strings LITERAL {
+ USED_TOKEN(LITERAL);
char *p = display_msg;
display_msg = xasprintf("%s %s", p, $2);
free(p);
}
;
partial: cdf_if /* text */
- | CDF_ELSE { scanner_parsing_toggle(); }
- | CDF_END_IF { scanner_parsing_pop(); }
+ | CDF_ELSE { USED_TOKEN(CDF_ELSE); scanner_parsing_toggle(); }
+ | CDF_END_IF { USED_TOKEN(CDF_END_IF); scanner_parsing_pop(); }
| cdf_evaluate /* text */
| cdf_eval_when /* text */
- | CDF_END_EVALUATE { scanner_parsing_pop(); }
+ | CDF_END_EVALUATE { USED_TOKEN(CDF_END_EVALUATE); scanner_parsing_pop(); }
;
cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override
}
YYERROR;
}
- if( symbols_begin() < symbols_end() ) {
- cbl_field_t field = cdf_literalize(@NAME, $NAME, $value);
- symbol_field_add(current_program_index(), &field);
- }
+ cdf_field_add( @NAME, $NAME, $value );
}
| CDF_DEFINE cdf_constant NAME EQ cdf_expr[value] override
}
| CDF_DEFINE cdf_constant NAME as OFF
{
+ USED_TOKEN(OFF);
cdfval_off( $NAME);
}
| CDF_DEFINE cdf_constant NAME as PARAMETER_kw override
}
}
| CDF_DEFINE FEATURE as ON {
+ USED_TOKEN(ON);
auto feature = cbl_gcobol_feature_t($2);
if( ! cobol_gcobol_feature_set(feature, true) ) {
error_msg(@FEATURE,
}
}
| CDF_DEFINE FEATURE as OFF {
+ USED_TOKEN(OFF);
auto feature = cbl_gcobol_feature_t($2);
if( ! cobol_gcobol_feature_set(feature, false) ) {
error_msg(@FEATURE,
}
;
cdf_constant: %empty
- | CONSTANT
- ;
+ | CONSTANT {
+ USED_TOKEN(CONSTANT);
+ }
+ ;
override: %empty { $$ = false; }
- | OVERRIDE { $$ = true; }
+ | OVERRIDE { $$ = true; USED_TOKEN(OVERRIDE); }
;
cdf_turn: TURN except_names except_check
cdf_call_convention:
CALL_COBOL {
+ USED_TOKEN(CALL_COBOL);
current_call_convention(cbl_call_cobol_e);
}
| CALL_VERBATIM {
+ USED_TOKEN(CALL_VERBATIM);
current_call_convention(cbl_call_verbatim_e);
}
;
cdf_push: CDF_PUSH cdf_stackable {
switch( $cdf_stackable ) {
- case YDF_ALL: cdf_push(); break;
- case YDF_CALL_CONVENTION: cdf_push_call_convention(); break;
- case YDF_CDF_DEFINE: cdf_push_dictionary(); break;
- case YDF_COBOL_WORDS: cdf_push_current_tokens(); break;
- case YDF_SOURCE_FORMAT: cdf_push_source_format(); break;
- default: gcc_unreachable();
+ case parser::token::YDF_ALL: cdf_push(); break;
+ case parser::token::YDF_CALL_CONVENTION: cdf_push_call_convention(); break;
+ case parser::token::YDF_CDF_DEFINE: cdf_push_dictionary(); break;
+ case parser::token::YDF_COBOL_WORDS: cdf_push_current_tokens(); break;
+ case parser::token::YDF_SOURCE_FORMAT: cdf_push_source_format(); break;
+ default: cdf_unreachable();
}
}
;
cdf_pop: CDF_POP cdf_stackable {
switch( $cdf_stackable ) {
- case YDF_ALL: cdf_pop(); break;
- case YDF_CALL_CONVENTION: cdf_pop_call_convention(); break;
- case YDF_CDF_DEFINE: cdf_pop_dictionary(); break;
- case YDF_COBOL_WORDS: cdf_pop_current_tokens(); break;
- case YDF_SOURCE_FORMAT: cdf_pop_source_format(); break;
- default: gcc_unreachable();
+ case parser::token::YDF_ALL: cdf_pop(); break;
+ case parser::token::YDF_CALL_CONVENTION: cdf_pop_call_convention(); break;
+ case parser::token::YDF_CDF_DEFINE: cdf_pop_dictionary(); break;
+ case parser::token::YDF_COBOL_WORDS: cdf_pop_current_tokens(); break;
+ case parser::token::YDF_SOURCE_FORMAT: cdf_pop_source_format(); break;
+ default: cdf_unreachable();
}
}
;
-cdf_stackable: ALL { $$ = YDF_ALL; }
- | CALL_CONVENTION { $$ = YDF_CALL_CONVENTION; }
- | COBOL_WORDS { $$ = YDF_COBOL_WORDS; }
- | CDF_DEFINE { $$ = YDF_CDF_DEFINE; }
- | SOURCE_FORMAT { $$ = YDF_SOURCE_FORMAT; }
+cdf_stackable: ALL { $$ = parser::token::YDF_ALL; }
+ | CALL_CONVENTION { $$ = parser::token::YDF_CALL_CONVENTION; }
+ | COBOL_WORDS { $$ = parser::token::YDF_COBOL_WORDS; }
+ | CDF_DEFINE { $$ = parser::token::YDF_CDF_DEFINE; }
+ | SOURCE_FORMAT { $$ = parser::token::YDF_SOURCE_FORMAT; }
;
except_names: except_name
;
except_check: CHECKING on { $$ = exception_turn.enable(true); }
- | CHECKING OFF { $$ = exception_turn.enable(false); }
+ | CHECKING OFF {
+ USED_TOKEN(OFF);
+ $$ = exception_turn.enable(false);
+ }
| CHECKING on with LOCATION
{
+ USED_TOKEN(LOCATION);
$$ = exception_turn.enable(true, true);
}
;
filenames: filename {
$$ = new std::set<size_t>;
- $$->insert(symbol_index(symbol_elem_of($1)));
+ $$->insert(cdf_file_index($1));
}
| filenames filename {
$$ = $1;
- auto inserted = $$->insert(symbol_index(symbol_elem_of($2)));
+ auto inserted = $$->insert(cdf_file_index($2));
if( ! inserted.second ) {
- error_msg(@2, "%s: No file-name shall be specified more than "
- "once for one exception condition", $filename->name);
+ error_msg(@2, "%s: No file-name shall be specified more than once "
+ "for one exception condition",
+ cdf_file_name($filename));
}
}
;
filename: NAME
{
- struct symbol_elem_t *e = symbol_file(PROGRAM, $1);
- if( !(e && e->type == SymFile) ) {
+ USED_TOKEN(NAME);
+ if( ($$ = cdf_file(PROGRAM, $1)) == nullptr ) {
error_msg(@NAME, "invalid file name '%s'", $NAME);
YYERROR;
}
- $$ = cbl_file_of(e);
}
;
cdf_if: CDF_IF cdf_cond_expr {
- scanner_parsing(YDF_CDF_IF, $2);
+ scanner_parsing(parser::token::YDF_CDF_IF, $2);
}
| CDF_IF error {
} CDF_END_IF { // not pushed, don't pop
+ USED_TOKEN(CDF_END_IF);
if( ! scanner_parsing() ) YYACCEPT;
}
;
cdf_evaluate: CDF_EVALUATE cdf_expr
- | CDF_EVALUATE TRUE_kw
+ | CDF_EVALUATE TRUE_kw {
+ USED_TOKEN(TRUE_kw);
+ }
;
cdf_eval_when: CDF_WHEN cdf_eval_obj
cdf_eval_obj: cdf_cond_expr
| cdf_expr THRU cdf_expr
- | OTHER
+ | OTHER {
+ USED_TOKEN(OTHER);
+ }
;
-cdf_cond_expr: BOOL
+cdf_cond_expr: BOOL {
+ USED_TOKEN(BOOL);
+ }
| NAME DEFINED
{
+ USED_TOKEN(DEFINED);
cdf_values_t& dictionary( cdf_dictionary() );
auto p = dictionary.find($1);
bool found = p != dictionary.end();
if( !$DEFINED ) found = ! found;
$$ = found;
if( found ) {
- dbgmsg("CDF: %s found in dictionary (result %s)",
- $1, $$? "true" : "false");
+ const char *aint = $DEFINED? "" : "not ";
+ dbgmsg("CDF: %s %sfound in dictionary (result %s)",
+ $1, aint, $$? "true" : "false");
} else {
dbgmsg("CDF: %s not found in dictionary (result %s)",
$1, $$? "true" : "false");
}
| cdf_bool_expr { $$ = $1(@1) == 0? false : true; }
| FEATURE DEFINED {
+ USED_TOKEN(DEFINED);
const auto& feature($1);
$$ = (feature == int(feature & cbl_gcobol_features));
dbgmsg("CDF: feature 0x%02x is %s", $1, $$? "ON" : "OFF");
;
cdf_factor: NAME {
+ USED_TOKEN(NAME);
cdf_values_t& dictionary( cdf_dictionary() );
auto that = dictionary.find($1);
if( that != dictionary.end() ) {
$$ = cdfval_t();
}
}
- | NUMBER { $$ = cdfval_t($1); }
- | LITERAL { $$ = cdfval_t($1); }
+ | NUMBER
+ {
+ USED_TOKEN(NUMBER);
+ $$ = cdfval_t($1);
+ }
+ | LITERAL {
+ USED_TOKEN(LITERAL);
+ $$ = cdfval_t($1);
+ }
| NUMSTR {
+ USED_TOKEN(NUMSTR);
auto value = integer_literal($NUMSTR);
if( !value.second ) {
error_msg(@1, "CDF error: parsed %qs as %lld",
bool add_whitespace = false;
replace_type_t type = {};
switch($a.token) {
- case YDF_NUMSTR:
- case YDF_LITERAL:
+ case parser::token::YDF_NUMSTR:
+ case parser::token::YDF_LITERAL:
type = string_e;
break;
- case YDF_NAME:
+ case parser::token::YDF_NAME:
type = token_e;
break;
- case YDF_PSEUDOTEXT:
+ case parser::token::YDF_PSEUDOTEXT:
type = pseudo_e;
- add_whitespace = $b.token != YDF_PSEUDOTEXT;
+ add_whitespace = $b.token != parser::token::YDF_PSEUDOTEXT;
break;
default:
cbl_err("%s:%d: logic error on token %s",
suppress: %empty
| SUPPRESS
{
+ USED_TOKEN(SUPPRESS);
copybook.suppress();
}
;
name_any: namelit
| PSEUDOTEXT {
- $$ = cdf_arg_t{YDF_PSEUDOTEXT, $1};
+ USED_TOKEN(PSEUDOTEXT);
+ $$ = cdf_arg_t{parser::token::YDF_PSEUDOTEXT, $1};
}
;
name_one: NAME
{
+ USED_TOKEN(NAME);
cdf_values_t& dictionary( cdf_dictionary() );
- cdf_arg_t arg = { YDF_NAME, $1 };
+ cdf_arg_t arg = { parser::token::YDF_NAME, $1 };
auto p = dictionary.find($1);
if( p != dictionary.end() ) {
}
$$ = arg;
}
- | NUMSTR { $$ = cdf_arg_t{YDF_NUMSTR, $1}; }
- | LITERAL { $$ = cdf_arg_t{YDF_LITERAL, $1}; }
+ | NUMSTR {
+ USED_TOKEN(NUMSTR);
+ $$ = cdf_arg_t{parser::token::YDF_NUMSTR, $1};
+ }
+ | LITERAL {
+ USED_TOKEN(LITERAL);
+ $$ = cdf_arg_t{parser::token::YDF_LITERAL, $1};
+ }
;
namelit: name
{
cdf_values_t& dictionary( cdf_dictionary() );
- cdf_arg_t arg = { YDF_NAME, $1 };
+ cdf_arg_t arg = { parser::token::YDF_NAME, $1 };
auto p = dictionary.find($1);
if( p != dictionary.end() ) {
free(const_cast<char*>($1));
free(const_cast<char*>($2));
- cdf_arg_t arg = { YDF_NAME, s };
+ cdf_arg_t arg = { parser::token::YDF_NAME, s };
$$ = arg;
}
- | NUMSTR { $$ = cdf_arg_t{YDF_NUMSTR, $1}; }
- | LITERAL { $$ = cdf_arg_t{YDF_LITERAL, $1}; }
+ | NUMSTR { $$ = cdf_arg_t{parser::token::YDF_NUMSTR, $1}; }
+ | LITERAL { $$ = cdf_arg_t{parser::token::YDF_LITERAL, $1}; }
;
-name: NAME
+name: NAME {
+ USED_TOKEN(NAME);
+ }
| name inof NAME
{
+ USED_TOKEN(NAME);
char *s = xasprintf( "%s %s %s", $1, $2, $3 );
assert($$ == $1);
free(const_cast<char*>($1));
$$ = s;
}
;
-inof: IN { static const char in[] = "IN"; $$ = in; }
- | OF { static const char of[] = "OF"; $$ = of; }
+inof: IN {
+ USED_TOKEN(IN);
+ static const char in[] = "IN"; $$ = in;
+ }
+ | OF {
+ USED_TOKEN(OF);
+ static const char of[] = "OF"; $$ = of;
+ }
;
subscripts: subscript
- | subscripts subscript
- {
+ | subscripts subscript {
char *s = xasprintf("%s%s", $1, $2 );
if( $$ != $1 ) free(const_cast<char*>($$));
free(const_cast<char*>($1));
$$ = s;
}
;
-subscript: SUBSCRIPT
+subscript: SUBSCRIPT {
+ USED_TOKEN(SUBSCRIPT);
+ }
| LSUB subscript RSUB
{
+ USED_TOKEN(RSUB);
char *s = xasprintf( "%s%s%s", $1, $2, $3 );
free(const_cast<char*>($1));
free(const_cast<char*>($2));
;
as: %empty
- | AS
+ | AS {
+ USED_TOKEN(AS);
+ }
;
on: %empty
- | ON
+ | ON {
+ USED_TOKEN(ON);
+ }
;
with: %empty
- | WITH
+ | WITH {
+ USED_TOKEN(WITH);
+ }
;
%%
-static YYLTYPE cdf_location;
+static cbl_loc_t cdf_location;
-static YYLTYPE
-location_set( const YYLTYPE& loc ) {
+static cbl_loc_t
+location_set( const cbl_loc_t& loc ) {
return cdf_location = loc;
}
if( yydebug ) {
if( cdf_name->second.is_numeric() ) {
- dbgmsg("%s: added -D %s = " HOST_SIZE_T_PRINT_DEC,
- __func__, name, (fmt_size_t)cdf_name->second.as_number());
+ dbgmsg("%s: added -D %s = %ld",
+ __func__, name, (long)cdf_name->second.as_number());
} else {
dbgmsg("%s: added -D %s = \"%s\"", __func__, name, cdf_name->second.string);
}
return lhs;
}
-#undef yylex
-int yylex(void);
-
-static int ydflex(void) {
- return yylex();
-}
-
bool
cdf_value( const char name[], const cdfval_t& value ) {
cdf_values_t& dictionary( cdf_dictionary() );
}
static bool
-verify_integer( const YDFLTYPE& loc, const cdfval_base_t& val ) {
+verify_integer( const cbl_loc_t& loc, const cdfval_base_t& val ) {
if( val.string ) {
error_msg(loc, "'%s' is not an integer", val.string);
return false;
}
const cdfval_base_t&
-cdfval_base_t::operator()( const YDFLTYPE& loc ) {
+cdfval_base_t::operator()( const cbl_loc_t& loc ) {
static cdfval_t zero(0);
// cppcheck-suppress returnTempReference
return verify_integer(loc, *this) ? *this : zero;
}
-
+namespace cdf {
+ void
+ parser::error(cbl_loc_t const& loc, std::string const& msg) {
+ error_msg(loc, msg.c_str());
+ }
+}
+
* We use the derived type cdfval_t, which can be properly constructed and
* operated on, but tell Bison only about its POD base class.
*/
-struct YDFLTYPE;
+
+struct cbl_loc_t;
+
struct cdfval_base_t {
bool off;
const char *string;
int64_t number;
- const cdfval_base_t& operator()( const YDFLTYPE& loc );
+ const cdfval_base_t& operator()( const cbl_loc_t& loc );
};
struct cdf_arg_t {
cdfval_base_t::string = NULL;
cdfval_base_t::number = value;
}
+#if GCC_TYPES
explicit cdfval_t( const REAL_VALUE_TYPE& r )
: lineno(yylineno), filename(cobol_filename())
{
HOST_WIDE_INT value = real_to_integer(&r);
cdfval_base_t::number = value;
}
+#endif
cdfval_t( const cdfval_base_t& value ) // cppcheck-suppress noExplicitConstructor
: lineno(yylineno), filename(cobol_filename())
{
#else
#define _COPYBOOK_H
+#if defined(CDF_Y)
+#define gcc_assert(x) assert(x)
+void gcc_unreachable(void);
+#endif
+
FILE * copy_mode_start();
const char * cobol_filename();
class copybook_elem_t {
friend copybook_t;
struct copybook_loc_t {
- YYLTYPE loc;
+ cbl_loc_t loc;
const char *name;
copybook_loc_t() : loc(), name(NULL) {}
} source, library;
char *regex_text;
};
+#ifndef TOUPPER
+#define CTOUPPER(S) ::toupper(S)
+#define TOUPPER(S) CTOUPPER(S)
+#endif
+
class uppername_t {
std::string upper;
public:
const char *data() const { return upper.data(); }
};
+#ifdef CTOUPPER
+#undef CTOUPPER
+#undef TOUPPER
+#endif
+
class copybook_t {
std::list<const char *> directories;
copybook_elem_t book;
void suppress( bool tf = true ) { book.suppress = tf; }
bool suppressed() { return book.suppress; }
- void source( const YYLTYPE& loc, const char name[] ) {
+ void source( const cbl_loc_t& loc, const char name[] ) {
book.source.loc = loc;
book.literally.source = copybook_elem_t::quoted(name);
book.source.name = book.literally.source?
copybook_elem_t::dequote(name) : transform_name(name);
}
- void library( const YYLTYPE& loc, const char name[] ) {
+ void library( const cbl_loc_t& loc, const char name[] ) {
book.library.loc = loc;
book.literally.library = copybook_elem_t::quoted(name);
book.library.name = book.literally.library?
const char *source() const { return book.source.name; }
const char *library() const { return book.library.name; }
- int open(YYLTYPE loc, const char name[]) {
+ int open(cbl_loc_t loc, const char name[]) {
int fd = -1;
book.clear();
this->source(loc, name);
extern const char * ec_type_str( ec_type_t type );
extern ec_disposition_t ec_type_disposition( ec_type_t type );
+struct cbl_label_t;
+
extern void declarative_runtime_match( const std::list<cbl_declarative_t>& declaratives,
cbl_label_t *lave );
continue
fi
- #cho "next arg: $opt" >&2
-
case $opt in
# pass next parameter to GCC
-echo) echo="echo"
;;
- -fec=*)
+ -fec=* | -fno-ec=*)
opt="$(echo "$opt" | sed -E 's/-f(no-)?ec=/-f\1cobol-exceptions=EC-/g')"
opts="$opts $opt"
;;
line-number consistency with the input, blank lines are retained.
.Pp
Unlike the C compiler, This option does not prevent compilation.
-To prevent compilation, use the option
-.D1 Fl Sy fsyntax-only
-also.
+To prevent compilation, use the
+.Fl Sy fsyntax-only
+option.
.It Fl fdefaultbyte Ns Li = Ns Ar value
Use
.Ar value ,
void
parser_label_label(struct cbl_label_t *label)
{
- label->lain = yylineno;
+ label->lain = cobol_location().first_line;
Analyze();
SHOW_PARSE
{
; Please try to keep this file in ASCII collating order.
+; After modifying any *.opt file, including this one, also update the
+; documentation with:
+;
+; make regenerate-opt-urls
+;
+; and include the *.opt.urls changes in the patch.
+
Language
Cobol
{}
};
-extern YYLTYPE yylloc;
+extern cbl_loc_t yylloc;
static const char *
last_newline (const char *p, const char *pend ) {
: parsed(false), fd(-1), nreplace(0), partial_line(line, eol) {}
};
-static YYLTYPE
+static cbl_loc_t
location_in( const filespan_t& mfile, const csub_match& cm ) {
- YYLTYPE loc {
+ cbl_loc_t loc {
int(mfile.lineno() + 1), int(mfile.colno() + 1),
int(mfile.lineno() + 1), int(mfile.colno() + 1)
};
bool replacing = !cm[20].matched;
if( library_name.matched ) {
- YYLTYPE loc = location_in( mfile, library_name );
+ cbl_loc_t loc = location_in( mfile, library_name );
copybook.library( loc, xstrndup(library_name.first, library_name.length()) );
}
- YYLTYPE loc = location_in( mfile, copybook_name );
+ cbl_loc_t loc = location_in( mfile, copybook_name );
outcome.fd = copybook.open( loc, xstrndup(copybook_name.first,
copybook_name.length()) );
if( outcome.fd == -1 ) { // let parser report missing copybook
return p == eol;
}
- YYLTYPE as_location() const {
- YYLTYPE loc;
+ cbl_loc_t as_location() const {
+ cbl_loc_t loc;
loc.first_line = loc.last_line = 1 + iline;
loc.first_column = loc.last_column = 1 + icol;
* the framework.
*/
extern int yychar;
-extern YYLTYPE yylloc;
+extern cbl_loc_t yylloc;
static const diagnostics::option_id option_zero;
gcc_location_set(yylloc); // use lookahead location
}
- explicit temp_loc_t( const YYLTYPE& loc) : orig(current_token_location()) {
- gcc_location_set(loc);
- }
- explicit temp_loc_t( const YDFLTYPE& loc) : orig(current_token_location()) {
+ explicit temp_loc_t( const cbl_loc_t& loc) : orig(current_token_location()) {
gcc_location_set(loc);
}
~temp_loc_t() {
#include "inspect.h"
}
+%define api.location.type {cbl_loc_t}
+
%{
+// yyssa never freed:
+// https://lists.nongnu.org/archive/html/help-bison/2021-01/msg00021.html
+#pragma GCC diagnostic ignored "-Wfree-nonheap-object"
+
#include "config.h"
#include <fstream> // Before cobol-system because it uses poisoned functions
#include "cobol-system.h"
declarative_list_t* dcl_list_t;
isym_list_t* isym_list;
struct { bool is_float; radix_t radix; char *string; } numstr;
- struct { YYLTYPE loc; int token; literal_t name; } prog_end;
+ struct { cbl_loc_base_t loc; int token; literal_t name; } prog_end;
struct { int token; special_name_t id; } special_type;
struct { char locale_type; const char * name; } locale_phrase;
coll_alphanat_t char_class_locales;
struct cbl_ffi_arg_t *ffi_arg;
struct ffi_args_t *ffi_args;
- struct { YYLTYPE loc; cbl_refer_t *ffi_name, *ffi_returning;
+ struct { cbl_loc_base_t loc; cbl_refer_t *ffi_name, *ffi_returning;
ffi_args_t *using_params; } ffi_impl;
struct { bool common, initial, recursive; } comminit;
struct { enum select_clause_t clause; cbl_file_t *file; } select_clause;
struct { size_t clauses; cbl_file_t *file; } select_clauses;
- struct { YYLTYPE loc; char *on, *off; } switches;
+ struct { cbl_loc_base_t loc; char *on, *off; } switches;
struct { cbl_encoding_t encoding; cbl_domain_t *domain; } false_domain;
struct { size_t also; unsigned char *low, *high; } colseq;
struct { cbl_field_attr_t attr; int nbyte; } pic_part;
cbl_field_t *
new_literal( const cbl_loc_t loc, const literal_t& lit, enum cbl_field_attr_t attr );
- static YYLTYPE first_line_of( YYLTYPE loc );
+ static cbl_loc_t first_line_of( cbl_loc_t loc );
%}
%locations
| file_descrs file_descr
;
file_descr: fd_name '.' { field_done(); } fields
- | fd_name fd_clauses '.' { field_done(); }
- fields
+ | fd_name fd_clauses '.' { field_done(); } fields
;
fd_name: FD NAME { $$ = file_section_fd_set(fd_e, $2, @2); }
$field->blank_initial($field->char_capacity());
}
$field->encode_numeric($field->data.original(),
- data_clause_locations[value_clause_e],
- $field->data.original_numeric());
+ data_clause_locations[value_clause_e]);
}
}
} else { // no VALUE clause
parser_label_label($label);
enabled_exceptions = current.enabled_exception_cache;
current.enabled_exception_cache.clear();
- ast_enter_section(implicit_section());
+ cbl_loc_t loc(@4); // the dot
+ loc.first_line++;
+ ast_enter_section(loc, implicit_section());
}
;
if( !label ) {
YYERROR;
}
- ast_enter_paragraph(label);
+ ast_enter_paragraph(@para, label);
current.new_paragraph(label);
apply_declaratives();
}
if( !label ) {
YYERROR;
}
- ast_enter_paragraph(label);
+ ast_enter_paragraph(@para, label);
current.new_paragraph(label);
apply_declaratives();
}
{
statement_begin(@1, SECTION);
$$ = label_add(@1, LblSection, $1);
- ast_enter_section($$);
+ ast_enter_section(@1, $$);
apply_declaratives();
}
| NAME section_kw // lexer swallows '.' before USE
<label>{
statement_begin(@1, SECTION);
$$ = label_add(@1, LblSection, $1);
- ast_enter_section($$);
+ ast_enter_section(@1, $$);
apply_declaratives();
} [label]
cdf_use dot
[]( const cbl_declarative_t *p ) {
return *p;
} );
- ast_enter_paragraph(when);
+ ast_enter_paragraph(@WHEN, when);
}
statements {
parser_exit_paragraph();
perform_ec_other:
%empty %prec WHEN {
const auto& ec_labels( perform_current()->ec_labels );
- ast_enter_paragraph(ec_labels.other);
+ ast_enter_paragraph(@$, ec_labels.other);
parser_exit_paragraph();
}
| WHEN OTHER {
const auto& ec_labels( perform_current()->ec_labels );
- ast_enter_paragraph(ec_labels.other);
+ ast_enter_paragraph(@$, ec_labels.other);
}
exception statements %prec WHEN {
parser_exit_paragraph();
perform_ec_common:
%empty {
const auto& ec_labels( perform_current()->ec_labels );
- ast_enter_paragraph(ec_labels.common);
+ ast_enter_paragraph(@$, ec_labels.common);
parser_exit_paragraph();
}
| WHEN COMMON {
const auto& ec_labels( perform_current()->ec_labels );
- ast_enter_paragraph(ec_labels.common);
+ ast_enter_paragraph(@$, ec_labels.common);
}
exception statements {
parser_exit_paragraph();
perform_ec_finally:
%empty {
const auto& ec_labels( perform_current()->ec_labels );
- ast_enter_paragraph(ec_labels.finally);
+ ast_enter_paragraph(@$, ec_labels.finally);
parser_exit_paragraph();
parser_label_goto(ec_labels.fini);
}
| FINALLY {
const auto& ec_labels( perform_current()->ec_labels );
- ast_enter_paragraph(ec_labels.finally);
+ ast_enter_paragraph(@$, ec_labels.finally);
}
exception statements {
parser_exit_paragraph();
isect = symbol_index(symbol_elem_of(sect));
}
- $$ = paragraph_reference(para, isect);
+ $$ = paragraph_reference(@1, para, isect);
assert($$);
dbgmsg( "using procedure %s of line %d", $$->name, $$->line );
}
;
function: %empty %prec FUNCTION
- { // typed_name in scan_ante.h allows FUNCTION keywod to be ommitted.
+ { // typed_name in scan_ante.h allows FUNCTION keyword to be ommitted.
statement_begin(@$, FUNCTION);
}
| FUNCTION
;
%%
-static YYLTYPE
-first_line_of( YYLTYPE loc ) {
+static cbl_loc_t
+first_line_of( cbl_loc_t loc ) {
if( loc.first_line < loc.last_line ) loc.last_line = loc.first_line;
if( loc.last_column < loc.first_column ) loc.last_column = loc.first_column;
return loc;
}
}
-void ast_call( const YYLTYPE& loc, cbl_refer_t name, const cbl_refer_t& returning,
+static void
+ast_call( const cbl_loc_t& loc, cbl_refer_t name, const cbl_refer_t& returning,
size_t narg, cbl_ffi_arg_t args[],
cbl_label_t *except,
cbl_label_t *not_except,
* parsed.
*/
static void
-statement_begin( const YYLTYPE& loc, int token ) {
+statement_begin( const cbl_loc_t& loc, int token ) {
static int prior_token = 0;
if( statement_cleanup ) {
typedef label_named<LblParagraph> paragraph_named;
static struct cbl_label_t *
-label_add( const YYLTYPE& loc,
+label_add( const cbl_loc_t& loc,
enum cbl_label_type_t type, const char name[] ) {
size_t parent = 0;
*/
static struct cbl_label_t *
label_add( enum cbl_label_type_t type, const char name[], int line ) {
- YYLTYPE loc { line, 1, line, 1 };
+ cbl_loc_t loc { line, 1, line, 1 };
return label_add(loc, type, name);
}
* detects and corrects its misstep.
*/
static struct cbl_label_t *
-paragraph_reference( const char name[], size_t section )
+paragraph_reference( const cbl_loc_t& loc, const char name[], size_t section )
{
// A reference has line == 0. It is LblParagraph if the section is
// explicitly named, else LblNone (because we don't know).
p = symbol_label_add(PROGRAM, &label);
assert(p);
-
+ const char *para_name = p->name;
const char *sect_name = section? cbl_label_of(symbol_at(section))->name : NULL;
+
+ match_proc::statement_compose( loc.first_line,
+ current.program_section(),
+ para_name, sect_name );
+
procedure_reference_add(sect_name, p->name, yylineno, current.program_section());
return p;
function_descr_t descr = { FUNCTION_UDF_0 };
descr.ret_type = FldInvalid;
const auto L = cbl_label_of(symbol_at(isym));
- bool ok = namcpy(YYLTYPE(), descr.name, L->name);
+ bool ok = namcpy(cbl_loc_t(), descr.name, L->name);
descr.prototype = prototype;
gcc_assert(ok);
return descr;
}
static cbl_refer_t *
-ast_op( YYLTYPE loc, cbl_refer_t *lhs, char op, cbl_refer_t *rhs ) {
+ast_op( const cbl_loc_t& loc, cbl_refer_t *lhs, char op, cbl_refer_t *rhs ) {
assert(lhs);
assert(rhs);
if( ! (is_numeric(lhs->field) && is_numeric(rhs->field)) ) {
}
static bool
-current_data_section_set(const YYLTYPE& loc, data_section_t data_section ) {
+current_data_section_set(const cbl_loc_t& loc, data_section_t data_section ) {
// order is mandatory
if( data_section < current_data_section ) {
error_msg(loc, "%s SECTION must precede %s SECTION",
#pragma GCC diagnostic pop
-void
-ast_inspect( YYLTYPE loc, cbl_refer_t& input, bool backward,
+static void
+ast_inspect( cbl_loc_t loc, cbl_refer_t& input, bool backward,
cbl_inspect_opers_t& inspects )
{
if( yydebug ) {
{
cbl_refer_t& tgt( target.refer );
if( ! valid_target(tgt) ) return false;
-#if 0
- if( field_index(target.refer.field) == return_code_register() ) return true;
-#endif
+
// Rule 1 c: is valid for VALUE, REPLACING, or DEFAULT
// If no VALUE (category none), set to blank/zero.
if( value_category == data_category_none && replacements.empty() ) {
break;
case dialect_gnu_e:
if( 0 == (cbl_dialects & dialect) ) { // first time
- cdf_tokens.equate(YYLTYPE(), "BINARY-DOUBLE", "BINARY-C-LONG");
+ cdf_tokens.equate(cbl_loc_t(), "BINARY-DOUBLE", "BINARY-C-LONG");
}
break;
}
}
static bool
-literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ) {
+literal_refmod_valid( cbl_loc_t loc, const cbl_refer_t& r ) {
+ if( r.field->has_attr(any_length_e) ) return true;
+
unsigned int nchar = r.field->char_capacity();
const cbl_span_t& refmod(r.refmod);
literal_subscript_oob( const cbl_refer_t& r, size_t& isub );
static bool
-literal_subscripts_valid( YYLTYPE loc, const cbl_refer_t& name ) {
+literal_subscripts_valid( cbl_loc_t loc, const cbl_refer_t& name ) {
size_t isub;
// Report any out-of-bound subscript.
}
static void
-subscript_dimension_error( YYLTYPE loc, size_t nsub, const cbl_refer_t *scalar ) {
+subscript_dimension_error( cbl_loc_t loc, size_t nsub, const cbl_refer_t *scalar ) {
if( 0 == dimensions(scalar->field) ) {
error_msg(loc, "%zu subscripts provided for %s, "
"which has no dimensions",
}
static void
-reject_refmod( YYLTYPE loc, const cbl_refer_t& scalar ) {
+reject_refmod( cbl_loc_t loc, const cbl_refer_t& scalar ) {
if( scalar.is_refmod_reference() ) {
error_msg(loc, "%s cannot be reference-modified here", scalar.name());
}
}
static bool
-require_pointer( YYLTYPE loc, const cbl_refer_t& scalar ) {
+require_pointer( cbl_loc_t loc, const cbl_refer_t& scalar ) {
if( scalar.field->type != FldPointer ) {
error_msg(loc, "%s must have USAGE POINTER", scalar.name());
return false;
}
static bool
-require_numeric( YYLTYPE loc, const cbl_refer_t& scalar ) {
+require_numeric( cbl_loc_t loc, const cbl_refer_t& scalar ) {
if( ! is_numeric(scalar.field) ) {
error_msg(loc, "%s must have numeric USAGE", scalar.name());
return false;
}
static bool
-require_integer( YYLTYPE loc, const cbl_refer_t& scalar ) {
+require_integer( cbl_loc_t loc, const cbl_refer_t& scalar ) {
if( is_literal(scalar.field) ) {
if( ! is_integer_literal(scalar.field) ) {
error_msg(loc, "numeric literal '%s' must be an integer",
* Do not set initial value; that is up to PICTURE and VALUE.
*/
static cbl_field_type_t
-field_binary_usage( YYLTYPE loc, cbl_field_t *field,
+field_binary_usage( cbl_loc_t loc, cbl_field_t *field,
cbl_field_type_t type, uint32_t capacity,
bool signable )
{
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wmissing-field-initializers"
-extern YYLTYPE yylloc;
+extern cbl_loc_t yylloc;
extern int yylineno, yyleng, yychar;
extern char *yytext;
linkage_datasect_e,
} current_data_section;
-static bool current_data_section_set( const YYLTYPE& loc, enum data_section_t );
+static bool current_data_section_set( const cbl_loc_t& loc, enum data_section_t );
enum data_clause_t {
picture_clause_e = 0x0001,
intrinsic_token_of( const char name[] );
static inline bool
-namcpy(const YYLTYPE& loc, cbl_name_t tgt, const char *src ) {
+namcpy(const cbl_loc_t& loc, cbl_name_t tgt, const char *src ) {
// snprintf(3): writes at most size bytes (including the terminating NUL byte)
auto len = snprintf(tgt, sizeof(cbl_name_t), "%s", src);
if( ! (0 < len && len < int(sizeof(cbl_name_t))) ) {
return new cbl_refer_t( new_temporary_like(skel) );
}
-static void reject_refmod( YYLTYPE loc, const cbl_refer_t& );
-static bool require_pointer( YYLTYPE loc, const cbl_refer_t& );
-static bool require_integer( YYLTYPE loc, const cbl_refer_t& );
+static void reject_refmod( cbl_loc_t loc, const cbl_refer_t& );
+static bool require_pointer( cbl_loc_t loc, const cbl_refer_t& );
+static bool require_integer( cbl_loc_t loc, const cbl_refer_t& );
struct cbl_field_t * constant_of( size_t isym );
cbl_file_t *file;
public:
file_start_args_t() : file(NULL) {}
- cbl_file_t * init( YYLTYPE loc, cbl_file_t *file ) {
+ cbl_file_t * init( cbl_loc_t loc, cbl_file_t *file ) {
this->file = file;
if( is_sequential(file) ) {
error_msg(loc, "START invalid with sequential file %s", file->name);
}
};
-static cbl_refer_t * ast_op( YYLTYPE loc,
+static cbl_refer_t * ast_op( const cbl_loc_t& loc,
cbl_refer_t *lhs, char op, cbl_refer_t *rhs );
static void ast_add( arith_t *arith );
}
static inline perform_t *
- perform_tgt_set( cbl_label_t *from, cbl_label_t *to = NULL ) {
+perform_tgt_set( cbl_label_t *from, cbl_label_t *to = NULL ) {
struct perform_t *perf = perform_current();
perf->tgt = cbl_perform_tgt_t(from, to);
+ match_proc::statement_add();
return perf;
}
};
static struct cbl_label_t *
-label_add( const YYLTYPE& loc, enum cbl_label_type_t type, const char name[] );
+label_add( const cbl_loc_t& loc, enum cbl_label_type_t type, const char name[] );
static struct cbl_label_t *
label_add( enum cbl_label_type_t type, const char name[], int line );
static struct cbl_label_t *
-paragraph_reference( const char name[], size_t section );
+paragraph_reference( const cbl_loc_t& loc, const char name[], size_t section );
static inline void
list_add( list<cbl_num_result_t>& list, const cbl_refer_t& refer, int round ) {
name_queue.allocate();
}
void
-tee_up_name( const YYLTYPE& loc, const char name[] ) {
+tee_up_name( const cbl_loc_t& loc, const char name[] ) {
name_queue.push(loc, name);
}
cbl_namelist_t
}
};
-void ast_inspect( YYLTYPE loc, cbl_refer_t& input, bool backward,
- cbl_inspect_opers_t& inspects );
+static void
+ast_inspect( cbl_loc_t loc, cbl_refer_t& input, bool backward,
+ cbl_inspect_opers_t& inspects );
template <typename E>
struct elem_list_t {
}
};
-static void ast_enter_section( cbl_label_t * );
-static void ast_enter_paragraph( cbl_label_t * );
+static void ast_enter_section( const cbl_loc_t& loc, cbl_label_t * );
+static void ast_enter_paragraph( const cbl_loc_t& loc, cbl_label_t * );
static class current_t {
friend cbl_options_t current_options();
return __gg__encoding_iconv_name(encoding);
}
- bool new_program ( const YYLTYPE& loc, cbl_label_type_t type,
+ bool new_program ( const cbl_loc_t& loc, cbl_label_type_t type,
const char name[], const char os_name[],
bool common, bool initial, bool recursive,
bool prototype = false )
return programs.empty()? NULL : programs.top().paragraph;
}
- bool is_first_statement( const YYLTYPE& loc ) {
+ bool is_first_statement( const cbl_loc_t& loc ) {
if( ! in_declaratives && first_statement == 0 ) {
auto eval = programs.top().declaratives_eval;
if( eval ) {
assert(!programs.empty());
+ match_proc::statements_verify();
+
const procref_t *ref = ambiguous_reference(program_index());
std::set<std::string> externals = programs.top().external_targets();
static std::unordered_set<size_t> callers_we_have_seen;
if( programs.size() == 1 ) {
- if( yydebug ) parser_call_targets_dump();
for( size_t caller : symbol_program_programs() ) {
// We are running through the entire growing list of called programs
// at the point of each END PROGRAM. This confuses the name changing
error_clients.clear();
exception_clients.clear();
- if( ref ) {
+ if( false && ref ) {
cbl_message(ParUnresolvedProcE,
"could not resolve paragraph (or section) '%s' at line %d",
ref->paragraph(), ref->line_number());
eval_label = label_add(LblSection, eval, yylineno);
struct cbl_label_t * lave_label = label_add(LblSection, lave, yylineno);
- ast_enter_section(eval_label);
+ ast_enter_section(cobol_location(), eval_label);
declarative_runtime_match(declaratives.as_list(), lave_label);
}
static void // add self to prototype map
-prototype_add( const YYLTYPE& loc, const std::list<cbl_ffi_arg_t>& args ) {
+prototype_add( const cbl_loc_t& loc, const std::list<cbl_ffi_arg_t>& args ) {
auto L = cbl_label_of(symbol_at(PROGRAM));
if( is_allowed_name(PROGRAM, L) ) {
// parser uses a list
}
static void
-verify_args( const YYLTYPE& loc,
+verify_args( const cbl_loc_t& loc,
const char name[], size_t narg,
const cbl_ffi_arg_t args[] );
static enum classify_t classify_of( int token );
-static void subscript_dimension_error( YYLTYPE loc, size_t, const cbl_refer_t *name );
+static void subscript_dimension_error( cbl_loc_t loc, size_t, const cbl_refer_t *name );
/*
* Utility functions
move_corresponding( cbl_refer_t& tgt, cbl_refer_t& src );
static bool
-literal_subscripts_valid( YYLTYPE loc, const cbl_refer_t& name );
+literal_subscripts_valid( cbl_loc_t loc, const cbl_refer_t& name );
static bool
-literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r );
+literal_refmod_valid( cbl_loc_t loc, const cbl_refer_t& r );
static bool
is_integer_literal( const cbl_field_t *field ) {
/*
* intrinsic calls
*/
-struct cbl_fieldloc_t {
- YYLTYPE loc;
- cbl_field_t *field;
-
- cbl_fieldloc_t() : loc{ 1,1, 1,1 }, field(NULL) {}
- cbl_fieldloc_t( const YYLTYPE& loc, cbl_field_t *field )
- : loc(loc), field(field)
- {}
-};
-
static size_t
intrinsic_invalid_parameter( int token, const std::vector<cbl_refer_t>& args );
static bool
intrinsic_call_1( cbl_field_t *output, int token,
- cbl_refer_t *r1, const YYLTYPE& loc ) {
+ cbl_refer_t *r1, const cbl_loc_t& loc ) {
std::vector<cbl_refer_t> args { *r1 };
if( 0 == intrinsic_invalid_parameter(token, args) ) {
error_msg(loc, "invalid parameter '%s'", r1->field->name);
}
static inline symbol_elem_t *
-symbol_find( const YYLTYPE& loc, const char *name ) {
+symbol_find( const cbl_loc_t& loc, const char *name ) {
cbl_namelist_t names;
if( ! name_queue.empty() ) {
auto names = name_queue.pop_as_names();
}
static bool
-valid_redefine( const YYLTYPE& loc,
+valid_redefine( const cbl_loc_t& loc,
const cbl_field_t *field, const cbl_field_t *orig ) {
// Must have same level.
if( field->level != orig->level ) {
}
static struct cbl_field_t *
-field_add( const YYLTYPE& loc, cbl_field_t *field ) {
+field_add( const cbl_loc_t& loc, cbl_field_t *field ) {
switch(current_data_section) {
case not_data_datasect_e:
case file_datasect_e:
static bool
field_type_update( cbl_field_t *field, cbl_field_type_t type,
- YYLTYPE loc,
+ cbl_loc_t loc,
bool is_usage = false)
{
// preserve NumericEdited if already established
}
static bool
-field_capacity_error( const YYLTYPE& loc, const cbl_field_t *field ) {
+field_capacity_error( const cbl_loc_t& loc, const cbl_field_t *field ) {
uint32_t parent_capacity = 0;
if( field->parent ) {
auto e = symbol_at(field->parent);
#pragma GCC diagnostic ignored "-Wmissing-field-initializers"
static struct cbl_field_t *
-field_alloc( const YYLTYPE& loc, cbl_field_type_t type, size_t parent, const char name[] ) {
+field_alloc( const cbl_loc_t& loc, cbl_field_type_t type, size_t parent, const char name[] ) {
static const uint32_t level = 0;
cbl_field_t *f, field = { type, 0, cbl_field_data_t(), level, name, yylineno };
field.parent = parent;
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wformat-truncation"
static cbl_file_t *
-file_add( YYLTYPE loc, cbl_file_t *file ) {
+file_add( cbl_loc_t loc, cbl_file_t *file ) {
gcc_assert(file);
enum { level = 1 };
struct cbl_field_t area{ FldAlphanumeric, level, yylineno },
return cbl_alphabet_of(e);
}
static cbl_alphabet_t *
-alphabet_add( const YYLTYPE& loc, cbl_encoding_t encoding ) {
+alphabet_add( const cbl_loc_t& loc, cbl_encoding_t encoding ) {
cbl_alphabet_t alphabet(loc, encoding);
return alphabet_add(alphabet);
}
}
static void
-set_real_from_capacity( const YYLTYPE& loc,
+set_real_from_capacity( const cbl_loc_t& loc,
cbl_field_t *field,
REAL_VALUE_TYPE *r ) {
if( field == current_field() ) {
}
static inline void
-ast_enter_section( cbl_label_t * section ) {
+ast_enter_section( const cbl_loc_t& loc, cbl_label_t * section ) {
assert(section);
- section->lain = yylineno;
+ section->lain = loc.first_line;
ast_enter_exit_section( section );
}
}
static void
-ast_enter_paragraph( cbl_label_t * para ) {
- para->lain = yylineno;
+ast_enter_paragraph( const cbl_loc_t& loc, cbl_label_t * para ) {
+ para->lain = loc.first_line;;
cbl_label_t *prior = current.new_paragraph(para);
if( prior ) {
parser_leave_paragraph(prior);
}
static bool
-procedure_division_ready( YYLTYPE loc, cbl_field_t *returning, ffi_args_t *ffi_args ) {
+procedure_division_ready( const cbl_loc_t& loc, cbl_field_t *returning, ffi_args_t *ffi_args ) {
auto prog = cbl_label_of(symbols_begin(current.program_index()));
if( prog->type == LblFunction ) {
parser_label_goto(tini_label);
// And here we create the initialization section:
- ast_enter_section(init_label); // _INITIALIZE_PROGRAM section.
+ ast_enter_section(loc, init_label); // _INITIALIZE_PROGRAM section.
parser_init_list();
// Lay down an implicit section to end the init_label
- ast_enter_section(implicit_section());
+ ast_enter_section(loc, implicit_section());
// This is the end of the island
parser_label_label(tini_label);
static size_t current_sort_file;
static size_t
-file_section_fd_set( file_entry_type_t type, char name[], const YYLTYPE& loc ) {
+file_section_fd_set( file_entry_type_t type, char name[], const cbl_loc_t& loc ) {
static std::set<size_t> has_fd;
// File must have been uniquely created by SELECT.
return file_section_fd > 0;
}
-void ast_call(const YYLTYPE& loc, cbl_refer_t name,
- const cbl_refer_t& returning,
- size_t narg, cbl_ffi_arg_t args[],
- cbl_label_t *except,
- cbl_label_t *not_except,
- bool is_function );
+static void
+ast_call(const cbl_loc_t& loc, cbl_refer_t name,
+ const cbl_refer_t& returning,
+ size_t narg, cbl_ffi_arg_t args[],
+ cbl_label_t *except,
+ cbl_label_t *not_except,
+ bool is_function );
cbl_field_t *
ast_file_status_between( file_status_t lower, file_status_t upper );
void internal_ebcdic_unlock();
static cbl_field_type_t
-field_binary_usage( YYLTYPE loc, cbl_field_t *field,
+field_binary_usage( cbl_loc_t loc, cbl_field_t *field,
cbl_field_type_t type, uint32_t capacity,
bool signable );
void
ast_end_program(const char name[] ) {
+ dbgmsg("%s:%d: program labels:", __func__, __LINE__);
std::for_each( symbols_begin(), symbols_end(),
[]( const auto& elem ) {
if( elem.type == SymLabel ) {
auto& L( *cbl_label_of(&elem) );
if( L.used ) {
if( ! L.lain ) {
- YYLTYPE loc { L.line, 1, L.line, 1 };
+ cbl_loc_t loc { L.line, 1, L.line, 1 };
error_msg(loc, "line %d: %s "
"is used on line %d and never defined",
L.line, L.name, L.used );
// false after USE statement, to enter Declarative with EC intact.
static bool statement_cleanup = true;
-static YYLTYPE current_location;
+static cbl_loc_t current_location;
static void statement_epilog( int token );
const char * keyword_str( int token );
-const YYLTYPE& cobol_location() { return current_location; }
+const cbl_loc_t& cobol_location() { return current_location; }
static inline void
-location_set( const YYLTYPE& loc ) {
+location_set( const cbl_loc_t& loc ) {
current_location = loc;
gcc_location_set(loc);
}
-static void statement_begin( const YYLTYPE& loc, int token );
+static void statement_begin( const cbl_loc_t& loc, int token );
-static void ast_first_statement( const YYLTYPE& loc ) {
+static void ast_first_statement( const cbl_loc_t& loc ) {
if( current.is_first_statement( loc ) ) {
parser_first_statement(loc.first_line);
}
[''""]/[01]
[01]+/[''""] { if( copy_state == YY_START ) {
ydflval.boolean = ((*yytext == 1) ^ is_not);
- return YDF_BOOL;
+ return cdf::parser::token::YDF_BOOL;
}
yylval.numstr.radix = boolean_e;
yylval.numstr.string = xstrdup(yytext);
[''""]/{hdseq}
{hdseq}/[''""] { if( copy_state == YY_START ) {
ydflval.number = integer_of(yytext, true);
- return YDF_NUMBER;
+ return cdf::parser::token::YDF_NUMBER;
}
if( 0 == yyleng % 2 ) {
yylval.literal.set_data( yyleng/2, hex_decode(yytext) );
[+-]?{INTEGERZ} { int value;
if( is_integer_token(&value) ) {
ydflval.number = value;
- return YDF_NUMBER;
+ return cdf::parser::token::YDF_NUMBER;
}
dbgmsg("%s not an integer = %d",
yytext, value);
size_t program_level();
-int ydfparse(void);
+static int ydfparse(void);
FILE * copy_mode_start();
static bool nonspace( char ch ) { return !ISSPACE(ch); }
+cdf::parser cdf_parser;
+cdf::parser::symbol_type cdf_symbol_type;
+cdf::parser::context cdf_context(cdf_parser, cdf_symbol_type);
+
+cdf::parser::value_type ydflval;
+cdf::parser::location_type ydflloc;
+
static int
numstr_of( const char string[], radix_t radix = decimal_e ) {
yylval.numstr.is_float = false;
/*
* CDF management
*/
-static int final_token;
-
static inline const char *
boolalpha( bool tf ) { return tf? "True" : "False"; }
void input_file_status_notify() { input_file_status.notify(); }
-/*
- * 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( const YYLTYPE *ploc = nullptr ) {
- YYLTYPE loc = {
+update_location( const cbl_loc_t *ploc = nullptr ) {
+ cbl_loc_t loc = {
yylloc.last_line, yylloc.last_column,
yylineno, yylloc.last_column + yyleng
};
loc.last_column = (yytext + yyleng) - p;
}
- yylloc = loc;
- ydflloc = ydfltype_of(yylloc);
+ ydflloc = yylloc = loc;
dbgmsg(" SC: %s location (%d,%d) to (%d,%d)",
start_condition_is(),
static void
reset_location() {
- static const YYLTYPE loc { yylineno, 1, yylineno, 1 };
+ static const cbl_loc_t loc { yylineno, 1, yylineno, 1 };
update_location(&loc);
}
#define not_implemented(...) cbl_unimplemented_at(yylloc, __VA_ARGS__)
#define YY_USER_INIT do { \
- static YYLTYPE ones = {1,1, 1,1}; \
- yylloc = ones; \
- ydflloc = ydfltype_of(yylloc); \
+ static cbl_loc_t ones = {1,1, 1,1}; \
+ ydflloc = yylloc = ones; \
} while(0)
/*
: crdb(0), currency(0), dot(0), pluses(0), minuses(0), stars(0)
{}
} exclusions;
- YYLTYPE loc;
+ cbl_loc_t loc;
bool is_crdb() const { // input must be uppercase for CR/DB
if( p[0] == 'C' || p[0] == 'D' ) {
if( !ch ) ch = *p; // use current character unless overridden
auto valid = followers.find(TOUPPER(ch));
if( valid == followers.end() ) {
- YYLTYPE loc(yylloc);
+ cbl_loc_t loc(yylloc);
loc.first_column += int(p - begin);
error_msg( loc, "PICTURE: strange character %qc, giving up", ch );
return nullptr;
return true; // all other CDF tokens valid regardless of context
}
+static int ydfparse() {
+ return cdf_parser.parse();
+}
+
+static inline int ydfchar() {
+ auto kind_type = cdf_context.lookahead().kind();
+ return kind_type;
+}
+
+void
+ydfdebug( bool yn ) {
+ cdf_parser.set_debug_level(yn? 1 : 0);
+}
+
static bool
run_cdf( int token ) {
if( ! valid_conditional_context(token) ) {
parsing.inject_token(token); // because it will be needed by CDF parser
- if( yy_flex_debug ) dbgmsg("CDF parser start with '%s'", keyword_str(token));
+ if( yy_flex_debug )
+ dbgmsg("%s: CDF parser start with '%s'", __func__, keyword_str(token));
parsing.parser_save(ydfparse);
if( YY_START == cdf_state ) yy_pop_state();
if( yy_flex_debug ) {
- dbgmsg("CDF parser returned %d, scanner SC <%s>", erc, start_condition_is());
+ dbgmsg("%s: CDF parser returned %d, scanner SC <%s>", __func__,
+ erc, start_condition_is());
}
return 0 == erc;
}
#include <queue>
-struct pending_token_t {
+struct recent_token_t {
int token;
YYSTYPE value;
- pending_token_t( int token, YYSTYPE value ) : token(token), value(value) {}
+ cbl_loc_t loc;
+ recent_token_t( int token, YYSTYPE value, cbl_loc_t loc )
+ : token(token), value(value), loc(loc) {}
};
-#define PENDING(T) pending_token_t( (T), yylval )
+#define RECENT(T) recent_token_t( (T), yylval )
-static std::queue<pending_token_t> pending_tokens;
+namespace cdf {
+ int used_token();
+}
-int next_token() {
+/*
+ * Each time the generated scanner returns a token from lexer(), it's pushed on
+ * the recent_tokens queue. The queue is 2 deep, representing the CDF parser's
+ * current and lookahead tokens.
+ */
+static struct recent_tokens_t : protected std::queue<recent_token_t>
+{
+ const recent_token_t& operator<<(int token) {
+ while( 1 < size() ) pop();
+ push( recent_token_t(token, yylval, yylloc) );
+ return front();
+ }
+
+ bool eof() const {
+ return size() == 1 && front().token == YYEOF;
+ }
+
+ int next() {
+ int end_token = cdf::used_token();
+
+ switch( size() ) {
+ default: gcc_unreachable();
+ case 0:
+ dbgmsg("%s:%d: 0 recent tokens []", __func__, __LINE__);
+ break;
+ case 1:
+ dbgmsg("%s:%d: 1 recent token [%s]", __func__, __LINE__,
+ keyword_str(back().token));
+ break;
+ case 2:
+ dbgmsg("%s:%d: 2 recent tokens [%s, %s]", __func__, __LINE__,
+ keyword_str(front().token),
+ keyword_str(back().token));
+ break;
+ }
+
+ /*
+ * Clear any used tokens. Return the unused token, if extant, which was
+ * the lookahead token. Because it was the last one returned by lexer(),
+ * the location is accurate. Else return the next token.
+ */
+ if( ! empty() && front().token == end_token ) pop();
+ if( ! empty() && back().token == end_token ) c.clear();
+
+ end_token = 0;
+
+ if( ! empty() ) {
+ end_token = front().token;
+ if( ! eof() ) {
+ pop();
+ assert(empty());
+ }
+ }
+
+ return end_token;
+ }
+} recent_tokens;
+
+static int next_token() {
int token = lexer();
+ recent_tokens << token;
return token;
}
-extern int ydfchar;
bool in_procedure_division(void);
// act on CDF tokens
while( is_cdf_token(token) ) {
if( ! run_cdf(token) ) {
- dbgmsg( ">>CDF parser failed, ydfchar %d", ydfchar );
+ dbgmsg( ">>CDF parser failed, ydfchar %d", ydfchar() );
+ }
+
+ token = recent_tokens.next();
+
+ if( recent_tokens.eof() ) {
+ dbgmsg("lexer() returned EOF (%d)", token);
+ return YYEOF;
}
- // Return the CDF's discarded lookahead token, if extant.
- token = ydfchar > 0? ydfchar : next_token();
+
+ if( token == 0 ) token = next_token();
+
if( token == NO_CONDITION && parsing.at_eof() ) {
+ dbgmsg("scanner at EOF, apparently (%d)", token);
return YYEOF;
}
+ dbgmsg("next token %s", keyword_str(token));
// Reenter cdf parser only if next token could affect parsing state.
if( ! parsing.on() && ! is_cdf_condition_token(token) ) break;
yylval.number = level_of(yylval.numstr.string);
token = LEVEL;
break;
- case YDF_NUMBER:
+ case cdf::parser::token::YDF_NUMBER:
dbgmsg("final token is YDF_NUMBER");
yylval.number = ydflval.number;
token = LEVEL;
}
}
- dbgmsg( ">>CDF parser done, %s returning "
- "%s (because final_token %s, lookhead %d) on line %d", __func__,
- keyword_str(token), keyword_str(final_token),
- ydfchar, yylineno );
+ dbgmsg( ">>CDF parser done, %s returning %s, conditional compilation %s", __func__,
+ keyword_str(token),
+ parsing.on()? "TRUE" : "FALSE" );
in_cdf = false;
return token;
}
* prelex calls lexer, the scanner produced by flex.
* lexer reads input from yyin via lexer_input.
*
- * prelex intercepts CDF statements, each of which it parses with ydfparse.
- * ydfparse affects CDF variables, which may affect how yylex treats
+ * prelex intercepts CDF statements, each of which it parses with cdf::parser::parse.
+ * cdf::parser::parse affects CDF variables, which may affect how yylex treats
* the input stream.
*
* Because the lexer is called recursively:
*
- * yyparse -> yylex -> ydfparse -> yylex
+ * yyparse -> yylex -> cdf::parser::parse -> yylex
+ *
+ * the global state of the scanner has to be managed, both before and after the
+ * CDF parser runs.
+ *
+ * Before invoking the CDF parser, run_cdf() stashes the CDF token with
+ * inject_token(). When the CDF parser turns around and calls yylex, the first
+ * token returned is that stashed one, because it is the reason the CDF parser
+ * was invoked.
+ *
+ * While the CDF parser is active, the scanner saves each token returned by
+ * lexer() in the recent_tokens queue. As the CDF parser uses a token, it
+ * records it such that it can be fetched with used_token(). A token fetched
+ * and *not* used was a lookahead token, and will be directed to the main
+ * parser.
+ *
+ * When the CDF parser returns, recent_tokens.next() compares the last two
+ * tokens fetched with the last one one used. If there's a recent token in the
+ * queue after the last one used, that's a lookahead token. It is returned to
+ * the main parser, which started the whole thing by calling yylex().
+ *
+ * It's not really necessary to keep the last two tokens for the post-parsing
+ * logic to work. It's enough to compare the last fetched token with the last
+ * used token.
*
- * the global state of the scanner has changed when ydfparse returns. Part of
- * that state is the unused lookahead token that ydfparse discarded, stored in
- * final_token. prelex then returns final_token as its own, which is duly
- * returned to yyparse.
+ * It *is* really necessary to for the CDF parser to record the tokens it
+ * actually uses, at least as things stand. The Bison C++ parser (which the
+ * CDF parser uses) records any token values that it doesn't define as -2,
+ * "invalid token". If the lookahead token is, say, MOVE, it cannot be
+ * retrieved from the CDF parser. That's why it's kept in the recent_tokens
+ * queue, where it's preceded by the last valid, used token, as recorded by the
+ * CDF parser.
*/
-
int
yylex(void) {
static bool produce_next_sentence_target = false;
produce_next_sentence_target = true;
}
- if( parsing.normal() ) {
- final_token = token;
- }
-
if( token == YYEOF && parsing.in_cdf() ) {
if( yy_flex_debug) dbgmsg("deflecting EOF");
parsing.at_eof(true);
return token;
}
+/*
+ * The CDF parser is a C++ parser. It passes pointers to the semantic value
+ * and location as parameters to the lexer. The generated lexer OTOH does not
+ * accept those parameters; rather it works with global variables in the
+ * old-fashioned C-style.
+ *
+ * Below we define the function the CDF parser calls to acquire a token. It
+ * calls the lexer, which writes to its global variables, copies that output to
+ * the passed parameters, and returns the token.
+ */
+namespace cdf {
+ int cdflex( parser::value_type *value, cbl_loc_t *loc ) {
+ int tok = ::yylex();
+ *value = ydflval;
+ *loc = yylloc;
+ return tok;
+ }
+}
+
/*
* Token name<->string utilities
*/
}
};
-static std::map<size_t, YYLTYPE> field_locs;
+static std::map<size_t, cbl_loc_t> field_locs;
void
-symbol_field_location( size_t ifield, const YYLTYPE& loc ) {
+symbol_field_location( size_t ifield, const cbl_loc_t& loc ) {
field_locs[ifield] = loc;
}
-YYLTYPE
+cbl_loc_t
symbol_field_location( size_t ifield ) {
auto p = field_locs.find(ifield);
gcc_assert(p != field_locs.end());
struct symbol_elem_t *
symbol_alphabet( size_t program, const char name[] )
{
- cbl_alphabet_t alphabet(YYLTYPE(), custom_encoding_e); // cppcheck-suppress syntaxError
+ cbl_alphabet_t alphabet(cbl_loc_t(), custom_encoding_e); // cppcheck-suppress syntaxError
assert(strlen(name) < sizeof alphabet.name);
strcpy(alphabet.name, name);
}
}
-cbl_alphabet_t::cbl_alphabet_t(const YYLTYPE& loc, size_t locale, cbl_name_t name )
+cbl_alphabet_t::cbl_alphabet_t(const cbl_loc_t& loc, size_t locale, cbl_name_t name )
: loc(loc)
, locale(locale)
, low_index(0)
}
bool
-cbl_alphabet_t::assign( const YYLTYPE& loc, unsigned char ch, unsigned char high_value ) {
+cbl_alphabet_t::assign( const cbl_loc_t& loc, unsigned char ch, unsigned char high_value ) {
if( collation_sequence[ch] == 0xFF || collation_sequence[ch] == high_value) {
collation_sequence[ch] = high_value;
last_index = ch;
}
void
-cbl_alphabet_t::also( const YYLTYPE& loc, size_t ch ) {
+cbl_alphabet_t::also( const cbl_loc_t& loc, size_t ch ) {
if( ch < 256 ) {
collation_sequence[ch] = collation_sequence[last_index];
if( ch == high_index ) high_index--;
cbl_loc_t
symbol_temporary_location( const cbl_field_t *field ) {
- extern YYLTYPE yylloc;
+ extern cbl_loc_t yylloc;
auto p = temporaries.locs.find(field);
return p == temporaries.locs.end()? cbl_loc_t(yylloc) : p->second;
}
return data.original();
}
- extern YYLTYPE yylloc;
+ extern cbl_loc_t yylloc;
+
const char *bad_boy = data.original();
if( 0 == loc.first_line )
- loc = level == 0 ? yylloc : symbol_field_location(field_index(this));
+ loc = level == 0 ? cbl_loc_t(yylloc) : symbol_field_location(field_index(this));
/*
* Hex-encoded means we don't convert. data.initial should be long enough to
// else try again
}
if( 0 == loc.first_line )
- loc = level == 0 ? yylloc : symbol_field_location(field_index(this));
+ loc = level == 0 ? cbl_loc_t(yylloc) : symbol_field_location(field_index(this));
error_msg( loc, "%<%c%> of %qs could not be converted from %s to %s: %s",
*bad_boy, data.original(),
cbl_encoding_str(
bool cbl_dialect_kind( cbl_dialect_t dialect, diagnostics::kind kind );
#endif
-enum cbl_gcobol_feature_t {
- feature_gcc_e = 0x00,
- feature_internal_ebcdic_e = 0x01,
- feature_embiggen_e = 0x02, // widen numeric that redefine POINTER
-};
-
extern size_t cbl_gcobol_features;
-bool cobol_gcobol_feature_set( cbl_gcobol_feature_t gcobol_feature, bool on = true );
static inline bool gcobol_feature_internal_ebcdic() {
return feature_internal_ebcdic_e ==
return *this;
}
- bool report_invalid_initial_value(const YYLTYPE& loc) const;
+ bool report_invalid_initial_value(const cbl_loc_t& loc) const;
bool is_ascii() const;
bool is_integer() const { return is_numeric(type) && data.rdigits == 0; }
void set_initial( size_t nchar, const cbl_loc_t& loc = cbl_loc_t() );
size_t source_code_check(const void *initial, size_t length);
const char * encode( size_t, cbl_loc_t loc = cbl_loc_t());
- void encode_numeric( const char input[], cbl_loc_t loc,
- const REAL_VALUE_TYPE& rvt = {});
+ void encode_numeric( const char input[], cbl_loc_t loc );
const char *value_str() const;
bool is_key_name() const { return has_attr(record_key_e); }
struct cbl_refer_t {
- YYLTYPE loc;
+ cbl_loc_t loc;
cbl_field_t *field;
cbl_label_t *prog_func;
bool all, addr_of;
, all(all), addr_of(false)
, refmod(NULL)
{}
- cbl_refer_t( const YYLTYPE& loc, cbl_field_t *field, bool all = false )
+ cbl_refer_t( const cbl_loc_t& loc, cbl_field_t *field, bool all = false )
: loc(loc), field(field), prog_func(NULL)
, all(all), addr_of(false)
, refmod(NULL)
* If the encoding is EBCDIC CP1140, then 'A' is 193 and collation_sequence[193] == 1.
*/
struct cbl_alphabet_t {
- YYLTYPE loc;
+ cbl_loc_t loc;
cbl_name_t name;
cbl_encoding_t encoding;
size_t locale; // index to cbl_locale_t symbol
memset(collation_sequence, 0xFF, sizeof(collation_sequence));
}
- cbl_alphabet_t(const YYLTYPE& loc, cbl_encoding_t enc)
+ cbl_alphabet_t(const cbl_loc_t& loc, cbl_encoding_t enc)
: loc(loc)
, encoding(enc)
, locale(0)
memset(collation_sequence, 0xFF, sizeof(collation_sequence));
}
- cbl_alphabet_t(const YYLTYPE& loc, size_t locale, cbl_name_t name );
+ cbl_alphabet_t(const cbl_loc_t& loc, size_t locale, cbl_name_t name );
- cbl_alphabet_t( const YYLTYPE& loc, const cbl_name_t name,
+ cbl_alphabet_t( const cbl_loc_t& loc, const cbl_name_t name,
unsigned char low_index, unsigned char high_index,
unsigned char collation_sequence[] )
: loc(loc)
}
void
- add_sequence( const YYLTYPE& loc, const unsigned char seq[] ) {
+ add_sequence( const cbl_loc_t& loc, const unsigned char seq[] ) {
if( low_index == 0 ) low_index = seq[0];
unsigned char last = last_index > 0? collation_sequence[last_index] + 1 : 0;
}
void
- add_interval( const YYLTYPE& loc, unsigned char low, unsigned char high ) {
+ add_interval( const cbl_loc_t& loc, unsigned char low, unsigned char high ) {
if( low_index == 0 ) low_index = low;
unsigned char last = collation_sequence[last_index];
}
}
- void also( const YYLTYPE& loc, size_t ch );
- bool assign( const YYLTYPE& loc, unsigned char ch, unsigned char value );
+ void also( const cbl_loc_t& loc, size_t ch );
+ bool assign( const cbl_loc_t& loc, unsigned char ch, unsigned char value );
bool reencode( const cbl_loc_t& loc );
static const char *
cbl_perform_tgt_t() : addresses(), ifrom(0), ito(0) {}
explicit cbl_perform_tgt_t( cbl_label_t * from, cbl_label_t *to = NULL )
- : addresses(), ifrom( from? symbol_index(symbol_elem_of(from)) : 0 )
+ : addresses()
+ , ifrom( from? symbol_index(symbol_elem_of(from)) : 0 )
, ito( to? symbol_index(symbol_elem_of(to)) : 0 )
{}
const char * current_declarative_section_name();
struct cbl_nameloc_t {
- YYLTYPE loc;
+ cbl_loc_t loc;
const char *name;
cbl_nameloc_t() : loc{ 1,1, 1,1 }, name(NULL) {}
- cbl_nameloc_t( const YYLTYPE& loc, const char *name )
+ cbl_nameloc_t( const cbl_loc_t& loc, const char *name )
: loc(loc), name(name)
{}
};
} );
return names;
}
- size_t push( const YYLTYPE& loc, const char name[] ) {
+ size_t push( const cbl_loc_t& loc, const char name[] ) {
assert( !empty() );
back().push_front( cbl_nameloc_t(loc, name) );
dump(__func__);
return size();
}
- void qualify( const YYLTYPE& loc, const char name[] ) {
+ void qualify( const cbl_loc_t& loc, const char name[] ) {
if( empty() ) {
allocate();
push(loc, name);
int binary_integer_usage_of( const char name[] );
void tee_up_empty();
-void tee_up_name( const YYLTYPE& loc, const char name[] );
+void tee_up_name( const cbl_loc_t& loc, const char name[] );
cbl_namelist_t teed_up_names();
size_t end_of_group( size_t igroup );
void symbol_registers_add();
-void symbol_field_location( size_t ifield, const YYLTYPE& loc );
-YYLTYPE symbol_field_location( size_t ifield );
+void symbol_field_location( size_t ifield, const cbl_loc_t& loc );
+cbl_loc_t symbol_field_location( size_t ifield );
bool symbol_label_section_exists( size_t program );
void wsclear( uint32_t ch);
const uint32_t *wsclear();
-enum cbl_call_convention_t {
- cbl_call_verbatim_e = 'V',
- cbl_call_cobol_e = 'N', // native
-};
-
int keyword_tok( const char * text, bool include_intrinsics = false );
int redefined_token( const cbl_name_t name );
tokenset_t();
int find( const cbl_name_t name, bool include_intrinsics );
- bool equate( const YYLTYPE& loc, int token,
+ bool equate( const cbl_loc_t& loc, int token,
const cbl_name_t name, const cbl_name_t verb = "EQUATE") {
auto lname( lowercase(name) );
auto cw = cobol_words.insert(lname);
}
return fOK;
}
- bool undefine( const YYLTYPE& loc,
+ bool undefine( const cbl_loc_t& loc,
const cbl_name_t name, const cbl_name_t verb = "UNDEFINE" ) {
auto lname( lowercase(name) );
auto cw = cobol_words.insert(lname);
return fOK;
}
- bool substitute( const YYLTYPE& loc,
+ bool substitute( const cbl_loc_t& loc,
const cbl_name_t extant, int token, const cbl_name_t name ) {
return
equate( loc, token, name, "SUBSTITUTE" )
&&
undefine( loc, extant, "SUBSTITUTE" );
}
- bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
+ bool reserve( const cbl_loc_t& loc, const cbl_name_t name ) {
auto lname( lowercase(name) );
auto cw = cobol_words.insert(lname);
if( ! cw.second ) {
int find( const cbl_name_t name, bool include_intrinsics ) {
return tokens.find(name, include_intrinsics);
}
- bool equate( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
+ bool equate( const cbl_loc_t& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
int token;
if( 0 == (token = binary_integer_usage_of(keyword)) ) {
if( 0 == (token = keyword_tok(keyword)) ) {
}
return tokens.equate(loc, token, alias);
}
- bool undefine( const YYLTYPE& loc, cbl_name_t keyword ) {
+ bool undefine( const cbl_loc_t& loc, cbl_name_t keyword ) {
return tokens.undefine(loc, keyword);
}
- bool substitute( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
+ bool substitute( const cbl_loc_t& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
int token;
if( 0 == (token = binary_integer_usage_of(keyword)) ) {
if( 0 == (token = keyword_tok(keyword)) ) {
dbgmsg("%s:%d: %s (%d) will have alias %s", __func__, __LINE__, keyword, token, alias);
return tokens.substitute(loc, keyword, token, alias);
}
- bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
+ 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 ) {
}
};
-cbl_call_convention_t current_call_convention();
current_tokens_t& cdf_current_tokens();
-void
-current_call_convention( cbl_call_convention_t convention);
-
class procref_base_t {
private:
const char *section_name, *paragraph_name;
}
int line_number() const { return line; }
+ const char *called_from() const {
+ return context? cbl_label_of(symbol_at(context))->name : "";
+ }
};
void procedure_definition_add( size_t program, const cbl_label_t *procedure );
int digits_of_picture(const char *picture, bool for_rdigits);
bool is_picture_scaled(const char *picture);
-template <typename LOC>
-void gcc_location_set( const LOC& loc );
+void gcc_location_set( const cbl_loc_t& loc );
// This is slightly oddball. This is an entry point in the charutf8.cc module.
// It's the only entry point in the module, and so it seemed to me wasteful to
}
void pop() {
if( empty() ) {
- error_msg(YYLTYPE(), "CDF stack empty"); // cppcheck-suppress syntaxError
+ error_msg(cbl_loc_t(), "CDF stack empty"); // cppcheck-suppress syntaxError
return;
}
current_value = top();
cdf_directives.source_format.value().description());
}
+void cdf_unreachable() { gcc_unreachable(); }
+
/*
* Construct a cbl_field_t from a CDF literal, to be installed in the symbol table.
*/
-cbl_field_t
+static cbl_field_t
cdf_literalize( const cbl_loc_t& loc,
const std::string& name, const cdfval_t& value,
- bool set_initial ) {
+ bool set_initial = true ) {
cbl_field_t field;
if( value.is_numeric() ) {
return field;
}
+cbl_file_t *
+cdf_file( size_t program, const cbl_name_t name ) {
+ symbol_elem_t *e = symbol_file(program, name);
+ if( e && e->type == SymFile ) {
+ return cbl_file_of(e);
+ }
+ return nullptr;
+}
+
+size_t
+cdf_file_index( const cbl_file_t *file ) {
+ return symbol_index(symbol_elem_of(file));
+}
+
+const char *
+cdf_file_name( const cbl_file_t *file ) {
+ return file->name;
+}
+
+
+void
+cdf_field_add( const cbl_loc_t& loc, const std::string& name, const cdfval_t& value ) {
+ if( symbols_begin() < symbols_end() ) {
+ cbl_field_t field = cdf_literalize(loc, name, value);
+ symbol_field_add(current_program_index(), &field);
+ }
+}
+
const std::list<cbl_field_t>
cdf_literalize() {
std::list<cbl_field_t> fields;
*/
void
-cbl_field_t::encode_numeric( const char input[], cbl_loc_t loc,
- const REAL_VALUE_TYPE& /*rvt*/ ) {
+cbl_field_t::encode_numeric( const char input[], cbl_loc_t loc ) {
gcc_assert(input);
gcc_assert(is_numeric(this) || type == FldNumericEdited);
size_t parse_error_count();
bool // true if error reported
-cbl_field_t::report_invalid_initial_value(const YYLTYPE& loc) const {
+cbl_field_t::report_invalid_initial_value(const cbl_loc_t& loc) const {
if( ! data.original() ) return false;
}
};
+/*
+ * Use a namespace to define sets of names. Use relational algebra to
+ * determine uniqueness or ambiguity of each PERFORM reference.
+ */
+namespace match_proc {
+ std::string
+ lcase( std::string name ) {
+ std::transform(name.begin(), name.end(), name.begin(), ftolower);
+ return name;
+ }
+
+ // PERFORM targets are captured by parser
+ struct stmt_t {
+ int line;
+ size_t curr; // current section of the PERFORM statement, else 0
+ struct tgt_t {
+ std::string name, qual;
+ bool empty() const { return name.empty(); }
+ bool operator==(const tgt_t& that) const {
+ return name == that.name && qual == that.qual;
+ }
+ tgt_t lcase() const {
+ tgt_t output{ match_proc::lcase(name), match_proc::lcase(qual) };
+ return output;
+ }
+ };
+ std::pair<tgt_t, tgt_t> tgts;
+
+ stmt_t() : line(0), curr(0) {}
+ stmt_t( int line, size_t isym,
+ std::string name,
+ const char qual[] )
+ : line(line), curr(isym)
+ {
+ tgts.first = tgt_t{name, qual? std::string(qual) : std::string() };
+ }
+ stmt_t& thru( std::string name, const char qual[] ) {
+ tgts.second = tgt_t{name, qual? std::string(qual) : std::string() };
+ return *this;
+ }
+ struct found_t {
+ size_t n, isym;
+ found_t() : n(0), isym(0) {}
+ found_t(size_t n, size_t isym) : n(n), isym(isym) {}
+ };
+ void error(const cbl_name_t program_name,
+ const tgt_t&tgt,
+ const found_t& found) const
+ {
+ const char *clause = tgt == tgts.first? "" : "THRU ";
+
+ switch( found.n ) {
+ case 1:
+ gcc_unreachable();
+ break;
+ case 0:
+ // error: not found
+ dbgmsg("%s:%d PERFORM %s%s not resolved",
+ program_name, line, clause, tgt.name.c_str());
+ break;
+ default:
+ assert( 1 < found.n );
+ // error: ambiguous
+ dbgmsg("%s:%d PERFORM %s%s ambiguous",
+ program_name, line, clause, tgt.name.c_str());
+ break;
+ }
+ }
+ };
+
+ struct sect_t {
+ size_t isym;
+ std::string name;
+ sect_t( size_t isym ) : isym(isym) {
+ auto L = cbl_label_of(symbol_at(isym));
+ name = lcase(L->name);
+ }
+ bool operator<( const sect_t& that ) const {
+ return name < that.name;
+ }
+ };
+ struct para_t {
+ size_t isym, parent;
+ std::string name;
+ para_t( size_t isym ) : isym(isym) {
+ auto L = cbl_label_of(symbol_at(isym));
+ parent = L->parent;
+ name = lcase(L->name);
+ }
+ bool operator<( const para_t& that ) const {
+ if( name == that.name ) {
+ return parent < that.parent;
+ }
+ return name < that.name;
+ }
+ std::string parent_name() const {
+ if( ! parent ) return std::string();
+ const auto f = cbl_label_of(symbol_at(parent));
+ return lcase(f->name);
+ }
+ };
+ struct proc_t {
+ size_t n, isym; // index of first of n matching pairs
+ std::string para, sect;
+ proc_t( size_t n, size_t isym,
+ const std::string& para,
+ const std::string& sect )
+ : n(n), isym(isym), para(para), sect(sect)
+ {}
+ bool operator<( const proc_t& that ) const {
+ if( para == that.para ) {
+ return sect < that.sect;
+ }
+ return para < that.para;
+ }
+ };
+
+ class procedures_t {
+ std::set<sect_t> sects;
+ std::set<para_t> paras;
+ std::set<proc_t> procs;
+ friend bool statements_verify();
+ public:
+ procedures_t( size_t program ) {
+ // find sections and paragraphs
+ for( symbol_elem_t *e = symbols_begin(program+1); e->program == program; e++ ) {
+ if( e->type == SymLabel ) {
+ const auto& L = *cbl_label_of(e);
+ auto isym = e - symbols_begin();
+ switch(L.type) {
+ case LblSection:
+ sects.insert(isym);
+ break;
+ case LblParagraph:
+ paras.insert(isym);
+ break;
+ default:
+ continue;
+ }
+ }
+ }
+ // join sections and paragraphs, unreduced
+ std::list<proc_t> all;
+ for( const auto& para : paras ) {
+ std::set<sect_t> parents;
+ std::copy_if( sects.begin(), sects.end(), std::inserter(parents, parents.begin()),
+ [para]( const auto& sect ) {
+ return para.parent_name() == sect.name;
+ } );
+ std::transform( parents.begin(), parents.end(), std::back_inserter(all),
+ [para]( const auto& sect ) {
+ proc_t proc(1, para.isym, para.name, sect.name);
+ return proc;
+ } );
+ }
+ // insert paragraph procedures
+ struct stat_t {
+ size_t n, isym;
+ stat_t() : n(0), isym(0) {}
+ stat_t update( size_t isym ) {
+ this->isym = this->isym == 0 ? isym : std::min(this->isym, isym);
+ n++;
+ return *this;
+ }
+ };
+ std::map<proc_t, stat_t> nprocs;
+ for( const auto& proc : all ) {
+ auto& stat = nprocs[proc];
+ stat.update( proc.isym );
+ }
+ std::transform(nprocs.begin(), nprocs.end(), std::inserter(procs, procs.begin()),
+ []( const auto& elem ) {
+ proc_t proc ( elem.second.n, elem.second.isym,
+ elem.first.para, elem.first.sect );
+ return proc;
+ } );
+ // insert section procedures
+ std::map<sect_t, stat_t> nsects;
+ for( const auto& sect : sects ) {
+ auto& stat = nsects[sect];
+ stat.update( sect.isym );
+ }
+ std::transform(nsects.begin(), nsects.end(), std::inserter(procs, procs.begin()),
+ []( const auto& elem ) {
+ proc_t proc ( elem.second.n, elem.second.isym,
+ std::string(), elem.first.name );
+ return proc;
+ } );
+ }
+
+ stmt_t::found_t
+ find( const stmt_t& stmt, const stmt_t::tgt_t& tgt ) {
+ if( tgt.empty() ) return stmt_t::found_t();
+ std::string curr ( lcase( cbl_label_of(symbol_at(stmt.curr))->name ) );
+
+ auto p = std::find_if(procs.cbegin(), procs.cend(),
+ [curr, tgt](auto proc) {
+ return match(proc, tgt, curr);
+ });
+ size_t n = std::count_if(p, procs.end(),
+ [curr, tgt](const auto& proc) {
+ return match(proc, tgt, curr);
+ });
+ stmt_t::found_t found = {n, 0};
+ if( n ) {
+ assert(p != procs.end());
+ found.isym = p->isym;
+ }
+ return found;
+ }
+ protected:
+ static bool match( const proc_t& proc, const stmt_t::tgt_t& tgt, const std::string& curr ) {
+ return ( proc.para == tgt.name && tgt.qual.empty() )
+ || ( proc.sect == tgt.name && tgt.qual.empty() )
+ || ( proc.para == tgt.name && proc.sect == tgt.qual )
+ || ( proc.para == tgt.name && proc.sect == curr );
+ }
+
+ void dump(const stmt_t& stmt) {
+ std::string target( stmt.tgts.first.name );
+ if( ! stmt.tgts.first.qual.empty() ) {
+ target += " of " + stmt.tgts.first.qual;
+ }
+ if( ! stmt.tgts.second.name.empty() ) {
+ target += " THRU " + stmt.tgts.second.name;
+ }
+ if( ! stmt.tgts.second.qual.empty() ) {
+ target += " of " + stmt.tgts.second.qual;
+ }
+
+ fprintf(stderr, "line %d in section #%lu: PERFORM %s\n",
+ stmt.line, (unsigned long)stmt.curr, target.c_str());
+ fprintf(stderr, "%lu Sections:\n", (unsigned long)sects.size());
+ for( auto sect : sects ) {
+ fprintf(stderr, "\t" "#%lu %s\n", (unsigned long)sect.isym, sect.name.c_str());
+ }
+ fprintf(stderr, "%lu Paragraphs:\n", (unsigned long)paras.size());
+ for( auto para : paras ) {
+ fprintf(stderr, "\t" "#%lu %s of #%lu\n",
+ (unsigned long)para.isym, para.name.c_str(), (unsigned long)para.parent);
+ }
+ fprintf(stderr, "%lu Procedures:\n", (unsigned long)procs.size());
+ for( auto proc : procs ) {
+ std::string section("");
+ if( ! proc.sect.empty() ) section += "of " + proc.sect;
+ fprintf(stderr, "\t" "n=%lu %s %s\n",
+ (unsigned long)proc.isym, proc.para.c_str(), section.c_str());
+ }
+ return;
+ }
+ }; // procedures
+
+
+ static stmt_t prototype;
+ static std::list<stmt_t> stmts;
+
+ bool
+ statements_verify() {
+ size_t nerr = 0;
+ size_t iprog = current_program_index();
+ const char *program_name = cbl_label_of(symbol_at(iprog))->name;
+ // instantiate procedure targets for current program from the symbol table
+ procedures_t procedures(iprog);
+
+ // Verify each PERFORM statement target is a unique reference
+ for( const auto& stmt : stmts ) {
+ stmt_t::found_t found = procedures.find(stmt, stmt.tgts.first.lcase());
+ stmt_t::found_t thru = procedures.find(stmt, stmt.tgts.second.lcase());
+
+ if( found.n == 1 && (thru.n == 1 || stmt.tgts.second.empty()) ) {
+ // update proc call list
+ if( stmt.tgts.first.qual.empty() ) {
+ dbgmsg("%s:%d PERFORM %s is ok", program_name, stmt.line,
+ stmt.tgts.first.name.c_str());
+ } else {
+ dbgmsg("%s:%d PERFORM %s of %s is ok", program_name, stmt.line,
+ stmt.tgts.first.name.c_str(),
+ stmt.tgts.first.qual.c_str());
+ }
+ continue;
+ }
+ nerr++;
+
+ if( found.n != 1 ) {
+ stmt.error(program_name, stmt.tgts.first, found);
+ if( nerr == 1 && yydebug ) {
+ procedures.dump(stmt);
+ }
+ }
+ if( thru.n != 1 && ! stmt.tgts.second.empty() ) {
+ stmt.error(program_name, stmt.tgts.second, thru);
+ }
+ }
+ return nerr == 0;
+ }
+
+ void statement_add() {
+ stmts.push_back(prototype);
+ prototype = stmt_t();
+ }
+ void
+ statement_compose( int line, size_t isection, // isection is where the PERFORM is
+ const cbl_name_t para,
+ const cbl_name_t qual ) {
+ std::string qual_name;
+ if( qual ) qual_name = qual;
+ if( prototype.tgts.first.name.empty() ) {
+ prototype = stmt_t( line, isection, para, qual );
+ } else {
+ prototype.thru( para, qual );
+ }
+ }
+} // end match_proc namespace
+
/*
* Every reference occurs in a {program,section,paragraph} context,
* even if they're implicit.
}
};
+#define DUMP_PROCEDURE_CALLS 0
+#if DUMP_PROCEDURE_CALLS
+static void procedure_calls_dump( size_t program ) {
+ procedures_t& procedures = programs[program];
+ for( const auto& proc : procedures ) {
+ const procdef_t& def(proc.first);
+ const auto& refs(proc.second);
+ auto L = def.label_of();
+ if( L ) {
+ fprintf(stderr, "call to %s", L->name);
+ if( L->parent ) {
+ auto S = cbl_label_of(symbol_at(L->parent));
+ fprintf(stderr, " of %s", S->name);
+ }
+ fprintf(stderr, ":\n");
+ for( const procref_t& ref : refs ) {
+ fprintf(stderr, "\t" "from %s ", ref.paragraph());
+ if( ref.section()[0] ) fprintf(stderr, "of %s", ref.section());
+ fprintf(stderr, "on line %d\n", ref.line_number());
+ }
+ }
+ }
+}
+#endif
+
procref_t *
ambiguous_reference( size_t program ) {
procedures_t& procedures = programs[program];
+#if DUMP_PROCEDURE_CALLS
+ procedure_calls_dump(program);
+#endif
for( const auto& proc : procedures ) {
procedures_t::mapped_type::const_iterator
ambiguous = find_if_not( proc.second.begin(), proc.second.end(),
is_unique(program, proc.first) );
if( proc.second.end() != ambiguous ) {
if( yydebug ) {
- dbgmsg("%s: %s of '%s' has " HOST_SIZE_T_PRINT_UNSIGNED
- "potential matches", __func__,
+ dbgmsg("%s: %s of '%s' has " HOST_SIZE_T_PRINT_UNSIGNED " "
+ "potential matches among references", __func__,
ambiguous->paragraph(), ambiguous->section(),
(fmt_size_t)procedures.count(procdef_t(*ambiguous)));
+ for( const auto& ref : proc.second ) {
+ fprintf(stderr, "\tline %d from {%s}: %s",
+ ref.line_number(), ref.called_from(), ref.paragraph());
+ if( ref.section()[0] ) fprintf(stderr, "of %s", ref.section());
+ fprintf(stderr, "\n");
+ }
}
return new procref_t(*ambiguous);
}
* with start and caret at the first line/column of LOC, and finishing at the
* last line/column of LOC.
*/
-template <typename LOC>
static void
-gcc_location_set_impl( const LOC& loc ) {
+gcc_location_set_impl( const cbl_loc_t& loc ) {
// Set the position to the first line & column in the location.
static location_t loc_m_1 = 0;
const location_t
location_dump(__func__, __LINE__, "parser", loc);
}
-void gcc_location_set( const YYLTYPE& loc ) {
+void gcc_location_set( const cbl_loc_t& loc ) {
gcc_location_set_impl(loc);
}
+#if 0
void gcc_location_set( const YDFLTYPE& loc ) {
gcc_location_set_impl(loc);
}
+#endif
#ifdef NDEBUG
# define verify_format(M)
}
extern int yychar;
-extern YYLTYPE yylloc;
+extern cbl_loc_t yylloc;
/*
* temp_loc_t is a hack in lieu of "%define parse.error custom". When
gcc_location_set(yylloc); // use lookahead location
}
- explicit temp_loc_t( const YYLTYPE& loc) : orig(token_location) {
- gcc_location_set(loc);
- }
- explicit temp_loc_t( const YDFLTYPE& loc) : orig(token_location) {
+ explicit temp_loc_t( const cbl_loc_t& loc) : orig(token_location) {
gcc_location_set(loc);
}
~temp_loc_t() {
global_dc->end_group();
-void error_msg( const YYLTYPE& loc, const char gmsgid[], ... ) {
+void error_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) {
ERROR_MSG_BODY
}
-void error_msg( const YDFLTYPE& loc, const char gmsgid[], ... )
+bool
+warn_msg( const cbl_loc_t& loc, const char gmsgid[], ... )
ATTRIBUTE_GCOBOL_DIAG(2, 3);
-void error_msg( const YDFLTYPE& loc, const char gmsgid[], ... ) {
- ERROR_MSG_BODY
-}
-
bool
-warn_msg( const YYLTYPE& loc, const char gmsgid[], ... ) {
+warn_msg( const cbl_loc_t& loc, const char gmsgid[], ... ) {
temp_loc_t looker(loc);
verify_format(gmsgid);
auto_diagnostic_group d;
#pragma GCC diagnostic pop
-extern int yy_flex_debug, yydebug, ydfdebug;
+extern int yy_flex_debug, yydebug;
extern int f_trace_debug;
void cobol_set_indicator_column( int column );
+void ydfdebug( bool yn );
void
cobol_set_debugging( bool flex, bool yacc, bool parser )
{
yy_flex_debug = flex? 1 : 0;
- ydfdebug = yydebug = yacc? 1 : 0;
+ yydebug = yacc? 1 : 0;
+ ydfdebug( yacc );
f_trace_debug = parser? 1 : 0;
}
}
void
-cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... ) {
+cbl_unimplemented_at( const cbl_loc_t& loc, const char *gmsgid, ... ) {
temp_loc_t looker(loc);
verify_format(gmsgid);
auto_diagnostic_group d;
#ifndef _UTIL_H_
#define _UTIL_H_
-[[noreturn]] void cbl_internal_error(const char *format_string, ...)
- ATTRIBUTE_GCOBOL_DIAG(1, 2);
-
-void cbl_err(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2);
-void cbl_errx(const char *format_string, ...) ATTRIBUTE_GCOBOL_DIAG(1, 2);
-
bool fisdigit(int c);
bool fisspace(int c);
int ftolower(int c);
};
-void cdf_push();
-void cdf_push_call_convention();
-void cdf_push_current_tokens();
-void cdf_push_dictionary();
-void cdf_push_enabled_exceptions();
-void cdf_push_source_format();
+/*
+ * Functions that validate every PERFORM calls a unique reference.
+ */
+namespace match_proc {
+ typedef char cbl_name_t[64];
-void cdf_pop();
-void cdf_pop_call_convention();
-void cdf_pop_current_tokens();
-void cdf_pop_dictionary();
-void cdf_pop_source_format();
-void cdf_pop_enabled_exceptions();
+ // Supply each target as it's mentioned.
+ void statement_compose( int iline, size_t isection,
+ const cbl_name_t para, const cbl_name_t qual );
+ // Add PERFORM to statement list.
+ void statement_add();
+ // Verify all statements and report problems.
+ bool statements_verify();
+}
#endif
{ cbl::PSX_O_APPEND, O_APPEND },
{ cbl::PSX_O_NONBLOCK, O_NONBLOCK },
{ cbl::PSX_O_DSYNC, O_DSYNC },
- { cbl::PSX_O_DIRECT, O_DIRECT },
- { cbl::PSX_O_DIRECTORY, O_DIRECTORY },
- { cbl::PSX_O_NOFOLLOW, O_NOFOLLOW },
- { cbl::PSX_O_CLOEXEC, O_CLOEXEC },
- { cbl::PSX_O_SYNC, O_SYNC },
- { cbl::PSX_O_PATH, O_PATH },
-#if 0
- // Linux, not POSIX
- { cbl::PSX_O_LARGEFILE, O_LARGEFILE },
- { cbl::PSX_O_NOATIME, O_NOATIME },
- { cbl::PSX_O_TMPFILE, O_TMPFILE },
+ { cbl::PSX_O_LARGEFILE, O_LARGEFILE },
+ { cbl::PSX_O_SYNC, O_SYNC },
+ /*
+ * The O_CLOEXEC, O_DIRECTORY, and O_NOFOLLOW flags are not specified in
+ * POSIX.1-2001, but are specified in POSIX.1-2008. See open(2).
+ */
+#if defined(_POSIX_C_SOURCE) && 200809L <= (_POSIX_C_SOURCE - 0)
+ { cbl::PSX_O_CLOEXEC, O_CLOEXEC },
+ { cbl::PSX_O_DIRECTORY, O_DIRECTORY },
+ { cbl::PSX_O_NOFOLLOW, O_NOFOLLOW },
+#else
+ { cbl::PSX_O_CLOEXEC, 0 },
+ { cbl::PSX_O_DIRECTORY, 0 },
+ { cbl::PSX_O_NOFOLLOW, 0 },
#endif
- };
+ /*
+ * The O_DIRECT, O_NOATIME, O_PATH, and O_TMPFILE flags are Linux-
+ * specific. One must define _GNU_SOURCE to obtain their definitions.
+ */
+#if defined(_GNU_SOURCE)
+ { cbl::PSX_O_DIRECT, O_DIRECT },
+ { cbl::PSX_O_NOATIME, O_NOATIME },
+ { cbl::PSX_O_PATH, O_PATH },
+ { cbl::PSX_O_TMPFILE, O_TMPFILE },
+#else
+ { cbl::PSX_O_DIRECT, 0 },
+ { cbl::PSX_O_NOATIME, 0 },
+ { cbl::PSX_O_PATH, 0 },
+ { cbl::PSX_O_TMPFILE, 0 },
+#endif
+ };
static const std::map<int, int> mode_bits {
{ cbl::PSX_S_IXOTH, S_IXOTH },
projects / thirdparty / gcc.git / commitdiff
