diff --git a/gcc/cobol/UAT/testsuite.src/fundamental.at b/gcc/cobol/UAT/testsuite.src/fundamental.at
index da67cdaf634888f5ef85f94a267702cec1935ed1..4d8bbcbd989202ec9015fddc38f697abecfea968 100644
--- a/gcc/cobol/UAT/testsuite.src/fundamental.at
+++ b/gcc/cobol/UAT/testsuite.src/fundamental.at
@@ -60,7 +60,7 @@ AT_DATA([prog.cob], [
77 this-should-fail_xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
PIC 9.
PROCEDURE DIVISION.
- DISPLAY "Gratuitous procedure division statement."
+ DISPLAY "Gratuitous procedure division statement.".
END PROGRAM prog.
])
AT_CHECK([$COMPILE prog.cob], [1], [], [prog.cob:7: syntax error: name truncated to 'this-should-work_xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' (max 63 characters) at 'this-should-work_xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
diff --git a/gcc/cobol/UAT/testsuite.src/syn_misc.at b/gcc/cobol/UAT/testsuite.src/syn_misc.at
index 0d52e21193483e0a7a8fcad0e04423a5ba6d08bd..7a8956d18495e1c46bbfaa2eebba67c04c0f2fe6 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_misc.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_misc.at
@@ -910,7 +910,7 @@ LINKAGE SECTION.
PROCEDURE DIVISION USING var1 RETURNING var2.
DISPLAY " I am COBOL routine_128_cobol".
DISPLAY var1
- MOVE var1 TO var2
+ MOVE var1 TO var2.
END PROGRAM routine_c.
])
AT_CHECK([$COMPILE prog.cob], [1], [],
@@ -919,6 +919,7 @@ prog.cob:5: error: no valid VALUE supplied
prog.cob:6: syntax error
prog.cob:6: error: no valid VALUE supplied
prog.cob:7: 4 errors in DATA DIVISION, compilation ceases at 'PROCEDURE DIVISION'
+prog.cob:11: END PROGRAM 'routine_c' does not match PROGRAM-ID 'routine_128_cobol'
cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
diff --git a/gcc/cobol/UAT/testsuite.src/syn_move.at b/gcc/cobol/UAT/testsuite.src/syn_move.at
index ac3ee79714872797dafeefe33d1fdb6dc201309f..b52b5db6df982ad717a531bd0031e5e6831e91f8 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_move.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_move.at
@@ -949,6 +949,8 @@ AT_DATA([prog.cob], [
AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
[prog.cob:8: error: line 6: 01 INVALID-ITEM requires PICTURE at 'PROCEDURE DIVISION'
prog.cob:8: 1 errors in DATA DIVISION, compilation ceases at 'PROCEDURE DIVISION'
+prog.cob:9: cannot MOVE '_literaln_1' (FldLiteralN) to 'INVALID-ITEM' (Fld)
+prog.cob:10: error: cannot MOVE SPACE to numeric receiving field I
cobol1: error: failed compiling prog.cob
])
diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index baca9bdc5a70adddf0e8d27159b2bba47b12e3bf..779141d95c64847ecb5d6f4e9ba52e5d0d5dc31f 100644
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -252,6 +252,9 @@ cobol_langhook_handle_option (size_t scode,
}
return true;
+ case OPT_fsyntax_only:
+ mode_syntax_only(identification_div_e);
+ break;
case OPT_preprocess:
if( ! preprocess_filter_add(arg) ) {
errx(EXIT_FAILURE, "error: could not execute preprocessor %s", arg);
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 7223e9c8ae8351252341216fd8d9782130cddd67..7436351702105a5f06ca026b4f1e5c9fbcbc0088 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -5035,6 +5035,8 @@ parser_move(cbl_refer_t destref,
void
parser_move(size_t ntgt, cbl_refer_t *tgts, cbl_refer_t src, cbl_round_t rounded)
{
+ if( mode_syntax_only() ) return;
+
cbl_figconst_t figconst = is_figconst(src);
if( figconst )
{
@@ -5291,11 +5293,11 @@ walk_initialization(cbl_field_t *field, bool initialized)
symbol_elem_t *e = symbol_at(field_index(field));
while( e < symbols_end() )
{
- symbol_elem_t element = *e++;
+ symbol_elem_t& element = *e++;
bool first_time = true;
if( element.type == SymField )
{
- cbl_field_t *this_one = element.elem.field;
+ cbl_field_t *this_one = cbl_field_of(&element);
if( !first_time )
{
if( this_one->level == LEVEL01 || this_one->level == LEVEL77 )
@@ -5430,10 +5432,10 @@ propogate_linkage_offsets(cbl_field_t *field, tree base)
e += 1;
while( e < symbols_end() )
{
- symbol_elem_t element = *e++;
+ symbol_elem_t& element = *e++;
if( element.type == SymField )
{
- cbl_field_t *this_one = element.elem.field;
+ cbl_field_t *this_one = cbl_field_of(&element);
if( this_one->level == LEVEL01 || this_one->level == LEVEL77 )
{
// We have encountered another level 01. If this LEVEL 01 had a
@@ -5550,6 +5552,8 @@ parser_division(cbl_division_t division,
// This is called when the parser enters a COBOL program DIVISION. See
// parser_divide for the arithmetic operation.
+ if( mode_syntax_only() ) return;
+
// Do this before the SHOW_PARSE; it makes a little more sense when reviewing
// the SHOW_PARSE output.
if( division == identification_div_e )
@@ -12061,6 +12065,7 @@ void parser_declarative_except( bool global,
void
parser_set_handled(ec_type_t ec_handled)
{
+ if( mode_syntax_only() ) return;
gg_assign(var_decl_exception_handled,
build_int_cst_type(INT, (int)ec_handled));
}
@@ -12068,6 +12073,7 @@ parser_set_handled(ec_type_t ec_handled)
void
parser_set_file_number(int file_number)
{
+ if( mode_syntax_only() ) return;
gg_assign(var_decl_exception_file_number,
build_int_cst_type(INT, file_number));
}
@@ -12564,7 +12570,7 @@ mh_identical(cbl_refer_t &destref,
if( (sourceref.field->attr & temporary_e) || !symbol_find_odo(sourceref.field) )
{
// Source doesn't have a depending_on clause
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("mh_identical()");
@@ -12593,7 +12599,7 @@ mh_dest_is_intermediate_binary( cbl_refer_t &destref,
{
case FldNumericBin5:
{
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("mh_dest_is_intermediate_binary() from FldNumericBin5");
@@ -12630,7 +12636,7 @@ mh_dest_is_intermediate_binary( cbl_refer_t &destref,
case FldLiteralN:
{
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("mh_dest_is_intermediate_binary() from FldLiteralN");
@@ -12672,7 +12678,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
case FldAlphanumeric:
{
refer_fill_dest(destref);
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("mh_source_is_literalN: __gg__psz_to_alpha_move")
@@ -12698,7 +12704,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
case FldIndex:
{
// We know this is a move to an eight-byte value:
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("mh_source_is_literalN: pointer/index")
@@ -12757,7 +12763,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
// We are moving from a FldLiteralN (which we know has no subscripts or
// refmods), to a NumericBin5, which might.
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("mh_source_is_literalN: FldNumericBin5")
@@ -12811,14 +12817,14 @@ mh_source_is_literalN(cbl_refer_t &destref,
case FldPacked:
{
tree berror = gg_define_int(0);
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("calling get_literalN_value ")
}
tree literalN_value = get_literalN_value(sourceref.field);
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("calling __gg__int128_to_refer ")
@@ -12844,7 +12850,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
case FldAlphaEdited:
{
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT(" FldAlphaEdited")
@@ -13653,7 +13659,7 @@ mh_little_endian( cbl_refer_t &destref,
|| destref.field->type == FldPointer
|| destref.field->type == FldIndex ) )
{
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("mh_little_endian")
@@ -13748,7 +13754,7 @@ move_helper(cbl_refer_t destref,
bool restore_on_error
)
{
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("move_helper()");
@@ -13832,7 +13838,7 @@ move_helper(cbl_refer_t destref,
if( !moved && sourceref.field->type == FldLiteralA)
{
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("__gg__move_literala")
@@ -13925,7 +13931,7 @@ move_helper(cbl_refer_t destref,
if( !moved )
{
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_INDENT
SHOW_PARSE_TEXT("default __gg__move")
@@ -13987,7 +13993,7 @@ move_helper(cbl_refer_t destref,
}
}
- SHOW_PARSE
+ SHOW_PARSE1
{
SHOW_PARSE_END
}
diff --git a/gcc/cobol/lang-specs.h b/gcc/cobol/lang-specs.h
index c3bd395389922064a20e373bbd883bb970e5551c..a6b5a2f61cacbebef34147d2a795aa52cfdb9db6 100644
--- a/gcc/cobol/lang-specs.h
+++ b/gcc/cobol/lang-specs.h
@@ -34,10 +34,10 @@
{".CBL", "@cobol", 0, 0, 0},
{"@cobol",
"cobol1 %i %(cc1_options) "
- "%{D*} %{E} %{I*} %{fmax-errors*} %{indicator-column*} "
+ "%{D*} %{E} %{I*} %{fmax-errors*} %{fsyntax-only*} "
"%{fcobol-exceptions*} "
"%{fstatic-call} "
- "%{ffixed-form} %{ffree-form} "
+ "%{ffixed-form} %{ffree-form} %{indicator-column*} "
"%{preprocess} "
"%{dialect} "
"%{nomain} "
diff --git a/gcc/cobol/lang.opt b/gcc/cobol/lang.opt
index 31f511aa1a7ec2a16698a43dc07246967784daf5..27824fe5fb48079913fb467a11492e63cc7b1636 100644
--- a/gcc/cobol/lang.opt
+++ b/gcc/cobol/lang.opt
@@ -69,6 +69,10 @@ ffixed-form
Cobol RejectNegative
Assume that the source file is fixed form.
+fsyntax-only
+Cobol RejectNegative
+; Documented in c.opt
+
ffree-form
Cobol RejectNegative
Assume that the source file is free form.
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index b0d9a6b283ff78c3a88107323b63df1a3206f184..0338d0ade43f791b1f01de435affc1b4c6d0fb21 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -920,7 +920,9 @@ programs: program
program: cdf_empty id_div options_para env_div data_div
{
- if( ! data_division_ready() ) YYERROR;
+ if( ! data_division_ready() ) {
+ mode_syntax_only(procedure_div_e);
+ }
current_division = procedure_div_e;
}
procedure_div
@@ -10332,7 +10334,9 @@ ast_op( cbl_refer_t *lhs, char op, cbl_refer_t *rhs ) {
ok:
cbl_field_t skel = determine_intermediate_type( *lhs, op, *rhs );
cbl_refer_t *tgt = new_reference_like(skel);
- parser_op( *tgt, *lhs, op, *rhs, current.compute_label() );
+ if( !mode_syntax_only() ) {
+ parser_op( *tgt, *lhs, op, *rhs, current.compute_label() );
+ }
return tgt;
}
@@ -11361,6 +11365,21 @@ cbl_field_t::value_str() const {
return string_of(data.value);
}
+static const cbl_division_t not_syntax_only = cbl_division_t(-1);
+ cbl_division_t cbl_syntax_only = not_syntax_only;
+
+void
+mode_syntax_only( cbl_division_t division ) {
+ cbl_syntax_only = division;
+}
+
+// Parser moves to syntax-only mode if data-division errors preclude compilation.
+bool
+mode_syntax_only() {
+ return cbl_syntax_only != not_syntax_only
+ && cbl_syntax_only <= current_division;
+}
+
void
cobol_dialect_set( cbl_dialect_t dialect ) {
cbl_dialect = dialect;
diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h
index f114293716bc049e73540555cdd32184166cee57..c739983593cfcbca469930b53fcad89f3286cd98 100644
--- a/gcc/cobol/scan_ante.h
+++ b/gcc/cobol/scan_ante.h
@@ -450,7 +450,7 @@ typed_name( const char name[] ) {
yylval.numstr.string = strdup(f->data.initial);
return NUMSTR;
}
- if( f->name != f->data.initial ) { // not a key-name literal
+ if( !f->has_attr(record_key_e) ) { // not a key-name literal
yylval.literal.set(f);
ydflval.string = yylval.literal.data;
return LITERAL;
diff --git a/gcc/cobol/show_parse.h b/gcc/cobol/show_parse.h
index a9d5c8ebb03c49410cb994025c14b12f3aae7399..55c56c6b080e6331e51f9863ab8affc89b4ce1dd 100644
--- a/gcc/cobol/show_parse.h
+++ b/gcc/cobol/show_parse.h
@@ -54,7 +54,12 @@ extern tree trace_handle;
extern tree trace_indent;
extern bool cursor_at_sol;
-#define SHOW_PARSE if(bSHOW_PARSE)
+#define RETURN_IF_PARSE_ONLY \
+ do { if( mode_syntax_only() ) return; } while(0)
+
+#define SHOW_PARSE1 if(bSHOW_PARSE)
+#define SHOW_PARSE RETURN_IF_PARSE_ONLY; if(bSHOW_PARSE)
+
// _HEADER and _END are generally the first and last things inside the
// SHOW_PARSE statement. They don't have to be; SHOW_PARSE can be used
// anywhere
@@ -421,7 +426,10 @@ class ANALYZE
level = analyze_level++;
char ach[128];
snprintf(ach, sizeof(ach), "# %s_%d_analyze_enter", func, level);
- gg_insert_into_assembler(ach);
+ if( !mode_syntax_only() )
+ {
+ gg_insert_into_assembler(ach);
+ }
}
}
~ANALYZE()
@@ -434,7 +442,10 @@ class ANALYZE
{
char ach[128];
snprintf(ach, sizeof(ach), "# %s_%d_analyze_exit", func, level);
- gg_insert_into_assembler(ach);
+ if( !mode_syntax_only() )
+ {
+ gg_insert_into_assembler(ach);
+ }
}
}
};
@@ -442,4 +453,4 @@ class ANALYZE
#define Analyze() ANALYZE Analyzer(__func__);
-#endif
\ No newline at end of file
+#endif
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 076115832ceafd9d634dd55f0adf533b3f5ea8f4..cbb3c2b4364c8de42e2e90891dad2d197dab5116 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -240,25 +240,6 @@ symbol_valid_udf_args( size_t function, std::list<cbl_refer_t> args ) {
return cbl_field_of(symbol_at(L->returning));
}
-/*
- * Compute start-of-element of which field is a member. "field" need
- * not be a true symbol in the symbol table; it could for example be a
- * local key, used for symbol lookups.
- */
-symbol_elem_t *
-symbol_elem_of( cbl_field_t **pfield ) {
- size_t n = offsetof(struct symbol_elem_t, elem.field);
- return
- reinterpret_cast<struct symbol_elem_t *>((char*)pfield - n);
-}
-
-const symbol_elem_t *
-symbol_elem_of( const cbl_field_t **pfield ) {
- size_t n = offsetof(struct symbol_elem_t, elem.field);
- return
- reinterpret_cast<const struct symbol_elem_t *>((const char*)pfield - n);
-}
-
static const struct cbl_occurs_t nonarray = cbl_occurs_t();
static const struct cbl_field_t empty_float = {
@@ -368,40 +349,14 @@ static cbl_field_t special_registers[] = {
static symbol_elem_t
elementize( cbl_field_t& field ) {
- symbol_elem_t elem = { .type = SymField, .elem = {.field = &field} };
+ symbol_elem_t elem = { .type = SymField, .elem = {.field = field} };
return elem;
}
-// match on field pointer
-static int
-symbol_field_ptr_cmp( const void *K, const void *E ) {
- const struct symbol_elem_t
- *k=static_cast<const struct symbol_elem_t *>(K),
- *e=static_cast<const struct symbol_elem_t *>(E);
-
- if( k->type != SymField ) {
- errx(EXIT_FAILURE, "%s: key must be field", __func__);
- }
- if( k->type != e->type ) return 1;
-
- return cbl_field_of(k) == cbl_field_of(e)? 0 : 1;
-}
-
size_t
field_index( const cbl_field_t *f ) {
assert(f);
- symbol_elem_t key = { SymField, 0, { .field = const_cast<cbl_field_t*>(f) } }, *e;
- size_t n = symbols.nelem;
-
- e = static_cast<struct symbol_elem_t *>(lfind(&key, symbols.elems,
- &n, sizeof(key),
- symbol_field_ptr_cmp));
- if( e != NULL ) {
- return e - symbols.elems;
- }
- warnx("field '%s' @ %p not found in symbol table", f->name, f);
- assert(e);
- return (size_t)-1;
+ return symbol_index(symbol_elem_of(f));
}
static inline bool
@@ -647,20 +602,6 @@ symbol_elem_cmp( const void *K, const void *E )
return strcasecmp(cbl_field_of(k)->name, cbl_field_of(e)->name);
}
-#if 0
-static void
-symbol_label_parent_set( struct cbl_label_t *label )
-{
- struct symbol_elem_t *e=symbols.elems + symbols.nelem;
-
- while( e-- > symbols.elems ) {
- if( e->type == SymLabel && label->parent < e->elem.label.parent ) {
- label->parent = e - symbols.elems;
- break;
- }
- }
-}
-#endif
cbl_label_ref_t::
cbl_label_ref_t( size_t program, const cbl_label_t& context, int line,
@@ -2050,32 +1991,10 @@ public:
void operator()( struct symbol_elem_t& e ) {
// cannot use cbl_field_of, because symbols.elems not yet ready
assert(e.type == SymField);
- e.elem.field->parent = this->parent_index;
+ e.elem.field.parent = this->parent_index;
}
};
-/*
- * When a symbol is added, look for a forward reference, and copy the
- * relevant bits. Normal searches don't look for forward declarations.
- */
-static void
-symbol_field_forward_set( size_t program, struct cbl_field_t *field )
-{
- size_t nelem = symbols.nelem;
- cbl_field_t key_field = *field;
- key_field.type = FldForward;
-
- struct symbol_elem_t *e, key = { SymField, program, { .field = &key_field } };
-
- e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems,
- &nelem, sizeof(key),
- symbol_elem_cmp ) );
- if( e ) {
- assert(field->var_decl_node == NULL);
- field->var_decl_node = cbl_field_of(e)->var_decl_node;
- }
-}
-
static symbol_elem_t
add_token( symbol_elem_t sym ) {
assert(sym.type == SymSpecial);
@@ -2128,7 +2047,7 @@ symbol_table_init(void) {
for( struct cbl_field_t *f = constants;
f < constants + COUNT_OF(constants); f++ ) {
f->our_index = table.nelem;
- struct symbol_elem_t e = { SymField, 0, { .field = f } };
+ struct symbol_elem_t e = { SymField, 0, { .field = *f } };
table.elems[table.nelem++] = e;
}
@@ -2339,7 +2258,7 @@ symbol_typedef_add( size_t program, struct cbl_field_t *field ) {
if( f == field ) return e;
}
- symbol_elem_t elem = { SymField, program, { .field = field } };
+ symbol_elem_t elem = { SymField, program, { .field = *field } };
e = symbol_add( &elem );
@@ -2440,7 +2359,7 @@ symbol_field_add( size_t program, struct cbl_field_t *field )
}
struct symbol_elem_t key = { .type = SymField, .program = program, NULL };
- key.elem.field = new cbl_field_t(*field);
+ key.elem.field = *field;
// Literals must have an initial value;
assert( !is_literal(field) || field->data.initial );
@@ -2463,8 +2382,6 @@ symbol_field_add( size_t program, struct cbl_field_t *field )
*p = key;
symbols.nelem++;
- symbol_field_forward_set(program, cbl_field_of(p));
-
return p;
}
@@ -2553,7 +2470,7 @@ symbol_literalA( size_t program, const char name[] )
field.data.initial = name;
field.attr = constq;
- struct symbol_elem_t key = { SymField, program, { .field = &field } };
+ struct symbol_elem_t key = { SymField, program, { .field = field } };
symbol_elem_t *start = symbols_begin(key.program), *e;
size_t nelem = symbols_end() - start;
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 5f265b3956395da6d62d412e00d6e2670fc6fe48..317353ba19496778b5512bbc49d7cf217c9e03e3 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -167,6 +167,9 @@ enum cbl_division_t {
procedure_div_e,
};
+void mode_syntax_only( cbl_division_t division );
+bool mode_syntax_only();
+
enum cbl_truncation_mode {
trunc_std_e,
trunc_opt_e,
@@ -1728,7 +1731,7 @@ struct symbol_elem_t {
union symbol_elem_u {
char *filename;
struct cbl_function_t function;
- struct cbl_field_t *field;
+ struct cbl_field_t field;
struct cbl_label_t label;
struct cbl_special_name_t special;
struct cbl_alphabet_t alphabet;
@@ -1780,6 +1783,19 @@ symbol_elem_of( const cbl_file_t *file ) {
reinterpret_cast<const symbol_elem_t *>((const char*)file - n);
}
+static inline symbol_elem_t *
+symbol_elem_of( cbl_field_t *field ) {
+ size_t n = offsetof(struct symbol_elem_t, elem.field);
+ return
+ reinterpret_cast<struct symbol_elem_t *>((char*)field - n);
+}
+static inline const symbol_elem_t *
+symbol_elem_of( const cbl_field_t *field ) {
+ size_t n = offsetof(symbol_elem_t, elem.field);
+ return
+ reinterpret_cast<const symbol_elem_t *>((const char*)field - n);
+}
+
symbol_elem_t * symbols_begin( size_t first = 0 );
symbol_elem_t * symbols_end(void);
cbl_field_t * symbol_redefines( const struct cbl_field_t *field );
@@ -1811,10 +1827,6 @@ const cbl_label_t * symbol_program_local( const char called[] );
bool redefine_field( cbl_field_t *field );
-symbol_elem_t * symbol_elem_of( cbl_file_t *file );
-symbol_elem_t * symbol_elem_of( cbl_field_t **pfield );
-const symbol_elem_t * symbol_elem_of( const cbl_field_t **pfield );
-
// Functions to correctly extract the underlying type.
static inline struct cbl_function_t *
cbl_function_of( struct symbol_elem_t *e ) {
@@ -1831,14 +1843,12 @@ cbl_section_of( struct symbol_elem_t *e ) {
static inline struct cbl_field_t *
cbl_field_of( struct symbol_elem_t *e ) {
assert(e->type == SymField);
- assert(e->elem.field != NULL);
- return e->elem.field;
+ return &e->elem.field;
}
static inline const struct cbl_field_t *
cbl_field_of( const struct symbol_elem_t *e ) {
assert(e->type == SymField);
- assert(e->elem.field != NULL);
- return e->elem.field;
+ return &e->elem.field;
}
static inline struct cbl_label_t *
@@ -2161,7 +2171,7 @@ field_at( size_t index ) {
struct symbol_elem_t *e = symbol_at(index);
assert(e->type == SymField);
- return e->elem.field;
+ return &e->elem.field;
}
bool symbols_alphabet_set( size_t program, const char name[]);
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index f47a43e6d303906c0d3b4139e1a84f0083468557..855e8d5372ca82bf5fdf787219b56e964b008d8a 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -496,7 +496,7 @@ is_alphanumeric( const cbl_field_t *field ) {
if( field->type != FldGroup ) return false;
- const struct symbol_elem_t *e = symbol_elem_of(&field);
+ const struct symbol_elem_t *e = symbol_elem_of(field);
for( ++e; e < symbols_end(); e++ ) {
if( e->type != SymField ) {