mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
Prior to this "patch", the GCOBOL compiler was capable of producing binaries that operated internally in either ASCII or EBCDIC. The COBOL specification, however, allows for the concurrent presence of two encodings, known as "alphanumeric" and "national". In order to support this capability, we have chosen to establish an "encoding" characteristic that gets carried along with every variable, This change affected many parts of the COBOL front end compiler. If anybody looks at any of the changes listed below, they will find they fall into two classes: 1) Removing the dependence on a global ASCII vs EBCDIC determination. 2) Adding a dependence on a new ::encoding characteristic of the compile time and run time cbl_field_t and cblc_field_t variable structures. Those structures now contain the cbl_encoding_t ::encoding members, which drive the use of the iconv(3) function in moving back and forth between variable encodings. Although the effort is not complete, these changes represent the bulk of what needs to be done. With these changes in place, all of our current ASCII and EBCDIC tests run properly. gcc/cobol/ChangeLog: * cdf.y: In support of the described changes. * gcobol.1: Likewise. * genapi.cc (level_88_helper): Likewise. (get_level_88_domain): Likewise. (get_class_condition_string): Likewise. (initialize_variable_internal): Likewise. (gg_default_qualification): Likewise. (cobol_compare): Likewise. (move_tree): Likewise. (move_tree_to_field): Likewise. (psa_FldBlob): Likewise. (parser_accept_date_yymmdd): Likewise. (parser_accept_date_yyyymmdd): Likewise. (parser_accept_date_yyddd): Likewise. (parser_accept_date_yyyyddd): Likewise. (parser_accept_date_dow): Likewise. (parser_accept_date_hhmmssff): Likewise. (parser_alphabet): Likewise. (parser_alphabet_use): Likewise. (parser_display_internal): Likewise. (parser_display): Likewise. (is_valuable): Likewise. (parser_division): Likewise. (parser_relop_long): Likewise. (parser_setop): Likewise. (parser_set_conditional88): Likewise. (parser_file_add): Likewise. (parser_file_open): Likewise. (create_and_call): Likewise. (parser_call): Likewise. (mh_identical): Likewise. (mh_source_is_literalN): Likewise. (picky_memcpy): Likewise. (mh_numeric_display): Likewise. (mh_source_is_group): Likewise. (mh_source_is_literalA): Likewise. (move_helper): Likewise. (initial_from_initial): Likewise. (actually_create_the_static_field): Likewise. (psa_FldLiteralA): Likewise. (parser_symbol_add): Likewise. * genmath.cc (arithmetic_operation): Likewise. * genutil.cc (get_binary_value): Likewise. (get_literal_string): Likewise. * genutil.h (EBCDIC_MINUS): Likewise. (EBCDIC_PLUS): Likewise. (EBCDIC_ZERO): Likewise. (EBCDIC_NINE): Likewise. * parse.y: Likewise. * parse_ante.h (name_of): Likewise. (class prog_descr_t): Likewise. (current_encoding): Likewise. (needs_picture): Likewise. (is_callable): Likewise. (field_attr_str): Likewise. (value_encoding_check): Likewise. (field_alloc): Likewise. (file_add): Likewise. * scan.l: Likewise. * structs.cc (create_cblc_field_t): Likewise. * symbols.cc (elementize): Likewise. (cbl_field_attr_str): Likewise. (is_variable_length): Likewise. (field_str): Likewise. (extend_66_capacity): Likewise. (assert): Likewise. (symbols_update): Likewise. (symbol_field_parent_set): Likewise. (add_token): Likewise. (symbol_table_init): Likewise. (symbol_field_add): Likewise. (symbol_field_forward_add): Likewise. (symbol_field_same_as): Likewise. (cbl_alphabet_t::reencode): Likewise. (new_temporary_impl): Likewise. (parser_symbol_add2): Likewise. (new_literal_add): Likewise. (temporaries_t::literal): Likewise. (new_literal): Likewise. (standard_internal): Likewise. (new_temporary): Likewise. (cbl_field_t::holds_ascii): Likewise. (cbl_field_t::is_ascii): Likewise. (cbl_field_t::internalize): Likewise. (symbol_label_add): Likewise. (symbol_label_section_exists): Likewise. (cbl_occurs_t::subscript_ok): Likewise. (cbl_file_t::deforward): Likewise. (has_value): Likewise. * symbols.h (is_numeric): Likewise. (__gg__encoding_iconv_name): Likewise. (current_encoding): Likewise. (struct cbl_field_t): Likewise. (new_literal): Likewise. (class temporaries_t): Likewise. (struct function_descr_t): Likewise. (hex_decode): Likewise. (struct cbl_alphabet_t): Likewise. (struct cbl_file_t): Likewise. * symfind.cc (field_structure): Likewise. (erase_symbol_map_fwds): Likewise. (symbol_find): Likewise. * token_names.h: Likewise. * util.cc (cbl_field_type_str): Likewise. (is_elementary): Likewise. (symbol_field_type_update): Likewise. (cbl_field_t::report_invalid_initial_value): Likewise. (valid_move): Likewise. (valid_picture): Likewise. (type_capacity): Likewise. (gcc_location_set_impl): Likewise. (cbl_unimplementedw): Likewise. libgcobol/ChangeLog: * charmaps.cc (raw_is_SBC): Likewise. (extract_next_code_point): Likewise. (flipper): Likewise. (__gg__ascii_to_ascii_chr): Likewise. (__gg__ascii_to_ebcdic_chr): Likewise. (__gg__raw_to_ascii): Likewise. (__gg__raw_to_ebcdic): Likewise. (convert_cp1252_to_utf8): Likewise. (__gg__text_conversion_override): Likewise. (__gg__ascii_to_ascii): Likewise. (__gg__encoding_iconv_name): Likewise. (__gg__encoding_iconv_type): Likewise. (__gg__ascii_to_ebcdic): Likewise. (__gg__iconverter): Likewise. (__gg__ebcdic_to_ascii): Likewise. (__gg__ascii_to_console): Likewise. (__gg__ebcdic_to_console): Likewise. (__gg__console_to_ascii): Likewise. (__gg__console_to_ebcdic): Likewise. (_to_ctype): Likewise. (_from_ctype): Likewise. (__gg__get_charmap): Likewise. * charmaps.h (internal_is_ebcdic): Likewise. (internal_space): Likewise. (internal_zero): Likewise. (internal_period): Likewise. (internal_comma): Likewise. (internal_dquote): Likewise. (internal_asterisk): Likewise. (internal_plus): Likewise. (internal_minus): Likewise. (internal_cr): Likewise. (internal_ff): Likewise. (internal_newline): Likewise. (internal_return): Likewise. (internal_0): Likewise. (internal_1): Likewise. (internal_2): Likewise. (internal_3): Likewise. (internal_4): Likewise. (internal_5): Likewise. (internal_6): Likewise. (internal_7): Likewise. (internal_8): Likewise. (internal_9): Likewise. (internal_colon): Likewise. (internal_query): Likewise. (internal_A): Likewise. (internal_B): Likewise. (internal_C): Likewise. (internal_D): Likewise. (internal_E): Likewise. (internal_F): Likewise. (internal_G): Likewise. (internal_H): Likewise. (internal_I): Likewise. (internal_J): Likewise. (internal_K): Likewise. (internal_L): Likewise. (internal_M): Likewise. (internal_N): Likewise. (internal_O): Likewise. (internal_P): Likewise. (internal_Q): Likewise. (internal_R): Likewise. (internal_S): Likewise. (internal_T): Likewise. (internal_U): Likewise. (internal_V): Likewise. (internal_W): Likewise. (internal_X): Likewise. (internal_Y): Likewise. (internal_Z): Likewise. (internal_a): Likewise. (internal_b): Likewise. (internal_c): Likewise. (internal_d): Likewise. (internal_e): Likewise. (internal_f): Likewise. (internal_g): Likewise. (internal_h): Likewise. (internal_i): Likewise. (internal_j): Likewise. (internal_k): Likewise. (internal_l): Likewise. (internal_m): Likewise. (internal_n): Likewise. (internal_o): Likewise. (internal_p): Likewise. (internal_q): Likewise. (internal_r): Likewise. (internal_s): Likewise. (internal_t): Likewise. (internal_u): Likewise. (internal_v): Likewise. (internal_w): Likewise. (internal_x): Likewise. (internal_y): Likewise. (internal_z): Likewise. (enum text_codeset_t): Likewise. (__gg__ascii_to_ascii_chr): Likewise. (__gg__ascii_to_ebcdic_chr): Likewise. (ascii_to_internal): Likewise. (__gg__ascii_to_ascii): Likewise. (__gg__ascii_to_ebcdic): Likewise. (ascii_to_internal_str): Likewise. (__gg__raw_to_ascii): Likewise. (__gg__raw_to_ebcdic): Likewise. (raw_to_internal): Likewise. (__gg__ascii_to_console): Likewise. (__gg__ebcdic_to_console): Likewise. (internal_to_console): Likewise. (__gg__console_to_ascii): Likewise. (__gg__console_to_ebcdic): Likewise. (console_to_internal): Likewise. (__gg__ebcdic_to_ascii): Likewise. (internal_to_ascii): Likewise. (__gg__encoding_iconv_name): Likewise. (__gg__encoding_iconv_type): Likewise. (__gg__iconverter): Likewise. (DEFAULT_CHARMAP_SOURCE): Likewise. (class charmap_t): Likewise. (__gg__get_charmap): Likewise. * common-defs.h (EBCDIC_MINUS): Likewise. (EBCDIC_PLUS): Likewise. (EBCDIC_ZERO): Likewise. (EBCDIC_NINE): Likewise. (PACKED_NYBBLE_PLUS): Likewise. (PACKED_NYBBLE_MINUS): Likewise. (PACKED_NYBBLE_UNSIGNED): Likewise. (NUMERIC_DISPLAY_SIGN_BIT_EBCDIC): Likewise. (NUMERIC_DISPLAY_SIGN_BIT): Likewise. (SEPARATE_PLUS): Likewise. (SEPARATE_MINUS): Likewise. (ZONED_ZERO): Likewise. (ZONE_SIGNED_EBCDIC): Likewise. (enum cbl_field_type_t): Likewise. (enum cbl_field_attr_t): Likewise. (enum cbl_figconst_t): Likewise. (enum cbl_encoding_t): Likewise. * constants.cc (struct cblc_field_t): Likewise. (X): Likewise. (S9): Likewise. * gcobolio.h: Likewise. * gfileio.cc (get_filename): Likewise. (relative_file_delete): Likewise. (relative_file_start): Likewise. (relative_file_rewrite): Likewise. (relative_file_write_varying): Likewise. (relative_file_write): Likewise. (sequential_file_write): Likewise. (line_sequential_file_read): Likewise. (sequential_file_read): Likewise. (relative_file_read): Likewise. (file_indexed_open): Likewise. (__gg__file_reopen): Likewise. (__io__file_open): Likewise. (__io__file_close): Likewise. (__gg__file_open): Likewise. * intrinsic.cc (trim_trailing_spaces): Likewise. (is_zulu_format): Likewise. (string_to_dest): Likewise. (get_all_time): Likewise. (ftime_replace): Likewise. (__gg__char): Likewise. (__gg__current_date): Likewise. (__gg__seconds_past_midnight): Likewise. (__gg__formatted_current_date): Likewise. (__gg__formatted_date): Likewise. (__gg__formatted_datetime): Likewise. (__gg__formatted_time): Likewise. (__gg__lower_case): Likewise. (numval): Likewise. (numval_c): Likewise. (__gg__ord): Likewise. (__gg__trim): Likewise. (__gg__random): Likewise. (__gg__random_next): Likewise. (__gg__reverse): Likewise. (__gg__upper_case): Likewise. (__gg__when_compiled): Likewise. (gets_int): Likewise. (gets_year): Likewise. (gets_month): Likewise. (gets_day): Likewise. (gets_day_of_week): Likewise. (gets_day_of_year): Likewise. (gets_week): Likewise. (gets_hours): Likewise. (gets_minutes): Likewise. (gets_seconds): Likewise. (gets_nanoseconds): Likewise. (fill_cobol_tm): Likewise. (__gg__hex_of): Likewise. (floating_format_tester): Likewise. (__gg__numval_f): Likewise. (__gg__test_numval_f): Likewise. (strcasestr): Likewise. (strlaststr): Likewise. (__gg__locale_compare): Likewise. (__gg__locale_date): Likewise. (__gg__locale_time): Likewise. (__gg__locale_time_from_seconds): Likewise. * libgcobol.cc (struct program_state): Likewise. (turn_sign_bit_on): Likewise. (turn_sign_bit_off): Likewise. (is_sign_bit_on): Likewise. (__gg__string_to_alpha_edited_ascii): Likewise. (int128_to_field): Likewise. (edited_to_binary): Likewise. (get_binary_value_local): Likewise. (__gg__get_date_yymmdd): Likewise. (__gg__get_date_yyyymmdd): Likewise. (__gg__get_date_yyddd): Likewise. (__gg__get_yyyyddd): Likewise. (__gg__get_date_dow): Likewise. (__gg__get_date_hhmmssff): Likewise. (__gg__dirty_to_binary_internal): Likewise. (__gg__dirty_to_binary): Likewise. (__gg__dirty_to_float): Likewise. (psz_to_internal): Likewise. (get_scaled_rdigits): Likewise. (format_for_display_internal): Likewise. (format_for_display_local): Likewise. (compare_88): Likewise. (compare_field_class): Likewise. (compare_strings): Likewise. (__gg__compare_2): Likewise. (init_var_both): Likewise. (alpha_to_alpha_move_from_location): Likewise. (alpha_to_alpha_move): Likewise. (__gg__move): Likewise. (__gg__move_literala): Likewise. (normalize_id): Likewise. (inspect_backward_format_1): Likewise. (__gg__inspect_format_1): Likewise. (inspect_backward_format_2): Likewise. (__gg__inspect_format_2): Likewise. (normalize_for_inspect_format_4): Likewise. (__gg__inspect_format_4): Likewise. (move_string): Likewise. (brute_force_trim): Likewise. (__gg__string): Likewise. (display_both): Likewise. (__gg__display_string): Likewise. (not_mangled_core): Likewise. (__gg__accept): Likewise. (__gg__set_initial_switch_value): Likewise. (__gg__onetime_initialization): Likewise. (is_numeric_display_numeric): Likewise. (is_alpha_a_number): Likewise. (__gg__classify): Likewise. (__gg__convert_encoding): Likewise. (__gg__convert_encoding_length): Likewise. (accept_envar): Likewise. (__gg__accept_envar): Likewise. (__gg__set_envar): Likewise. (__gg__get_argc): Likewise. (__gg__get_argv): Likewise. (__gg__get_command_line): Likewise. (__gg__alphabet_use): Likewise. (__gg__ascii_to_internal_field): Likewise. (__gg__ascii_to_internal): Likewise. (__gg__console_to_internal): Likewise. (__gg__parser_set_conditional): Likewise. (__gg__internal_to_console_in_place): Likewise. (__gg__literaln_alpha_compare): Likewise. (__gg__unstring): Likewise. (struct cbl_exception_t): Likewise. (__gg__codeset_figurative_constants): Likewise. (__gg__function_handle_from_cobpath): Likewise. (__gg__just_mangle_name): Likewise. (__gg__function_handle_from_name): Likewise. (get_the_byte): Likewise. (__gg__set_env_name): Likewise. (__gg__get_env_name): Likewise. (__gg__get_env_value): Likewise. (__gg__set_env_value): Likewise. (__gg__fprintf_stderr): Likewise. (__gg__accept_arg_value): Likewise. (__gg__fc_char): Likewise. * libgcobol.h (__gg__dirty_to_binary_internal): Likewise. (__gg__dirty_to_binary): Likewise. (__gg__internal_to_console_in_place): Likewise. (__gg__fc_char): Likewise. (__gg__convert_encoding): Likewise. (__gg__convert_encoding_length): Likewise. * stringbin.cc (string_from_combined): Likewise. (__gg__binary_to_string_internal): Likewise. (__gg__binary_to_string_encoded): Likewise. (__gg__numeric_display_to_binary): Likewise. (__gg__packed_to_binary): Likewise. * stringbin.h (__gg__binary_to_string_internal): Likewise. (__gg__binary_to_string_encoded): Likewise. (__gg__numeric_display_to_binary): Likewise. * valconv.cc (__gg__alphabet_create): Likewise. (__gg__string_to_numeric_edited): Likewise. (__gg__string_to_alpha_edited): Likewise. (__gg__remove_trailing_zeroes): Likewise. * valconv.h (__VALCONV_H): Likewise. * encodings.h: New file. gcc/testsuite/ChangeLog: * cobol.dg/group1/check_88.cob: Likewise.
585 lines
17 KiB
C++
585 lines
17 KiB
C++
/*
|
|
* Copyright (c) 2021-2025 Symas Corporation
|
|
* All rights reserved.
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions are
|
|
* met:
|
|
*
|
|
* * Redistributions of source code must retain the above copyright
|
|
* notice, this list of conditions and the following disclaimer.
|
|
* * Redistributions in binary form must reproduce the above
|
|
* copyright notice, this list of conditions and the following disclaimer
|
|
* in the documentation and/or other materials provided with the
|
|
* distribution.
|
|
* * Neither the name of the Symas Corporation nor the names of its
|
|
* contributors may be used to endorse or promote products derived from
|
|
* this software without specific prior written permission.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
* (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 "../../libgcobol/ec.h"
|
|
#include "../../libgcobol/common-defs.h"
|
|
#include "util.h"
|
|
#include "cbldiag.h"
|
|
#include "symbols.h"
|
|
#include "inspect.h"
|
|
#include "../../libgcobol/io.h"
|
|
#include "genapi.h"
|
|
|
|
extern int yydebug;
|
|
|
|
static bool
|
|
is_data_field( symbol_elem_t& e ) {
|
|
if( e.type != SymField ) return false;
|
|
const cbl_field_t *f = cbl_field_of(&e);
|
|
if( f->name[0] == '\0' ) return false;
|
|
if( is_filler(f) ) return false;
|
|
|
|
return f->type != FldForward;
|
|
}
|
|
|
|
class sym_name_t {
|
|
public: // TEMPORARY
|
|
const char *name;
|
|
size_t program, parent;
|
|
public:
|
|
explicit sym_name_t( const char name[] )
|
|
: name(name), program(0), parent(0) { assert(name[0] == '\0'); }
|
|
sym_name_t( size_t program, const char name[], size_t parent )
|
|
: name(name), program(program), parent(parent) {}
|
|
|
|
const char * c_str() const { return name; }
|
|
|
|
// Order by: Program, Name, Parent.
|
|
bool operator<( const sym_name_t& that ) const {
|
|
if( program == that.program ) {
|
|
int by_name = strcasecmp(name, that.name);
|
|
return by_name == 0? parent < that.parent : by_name < 0;
|
|
}
|
|
return program < that.program;
|
|
}
|
|
bool operator==( const char *name ) const {
|
|
return strcasecmp(this->name, name) == 0;
|
|
}
|
|
|
|
bool same_program( size_t program ) const {
|
|
return program == this->program;
|
|
}
|
|
};
|
|
|
|
typedef std::map< sym_name_t, std::vector<size_t> > symbol_map_t;
|
|
|
|
|
|
static symbol_map_t symbol_map;
|
|
|
|
typedef std::map <field_key_t, std::list<size_t> > field_keymap_t;
|
|
static field_keymap_t symbol_map2;
|
|
|
|
/*
|
|
* As each field is added to the symbol table, add its name and index
|
|
* to the name map. Initially the type is FldInvalid. Those are
|
|
* removed by symbols_update();
|
|
*/
|
|
void
|
|
update_symbol_map2( const symbol_elem_t *e ) {
|
|
auto field = cbl_field_of(e);
|
|
|
|
if( ! field->is_typedef() ) {
|
|
switch( field->type ) {
|
|
case FldForward:
|
|
case FldLiteralN:
|
|
return;
|
|
case FldLiteralA:
|
|
if( ! field->is_key_name() ) return;
|
|
break;
|
|
default:
|
|
break;
|
|
}
|
|
}
|
|
|
|
field_key_t fk( e->program, field );
|
|
symbol_map2[fk].push_back(symbol_index(e));
|
|
}
|
|
|
|
/*
|
|
* Purge any field whose type is FldInvalid. Remove any names that do
|
|
* not map to any field.
|
|
*/
|
|
void
|
|
finalize_symbol_map2() {
|
|
std::set<field_key_t> empties;
|
|
|
|
for( auto& elem : symbol_map2 ) {
|
|
auto& fields( elem.second );
|
|
fields.remove_if( []( auto isym ) {
|
|
const cbl_field_t *f = cbl_field_of(symbol_at(isym));
|
|
return f->type == FldInvalid;
|
|
} );
|
|
if( fields.empty() ) empties.insert(elem.first);
|
|
}
|
|
|
|
for( const auto& key : empties ) {
|
|
symbol_map2.erase(key);
|
|
}
|
|
}
|
|
|
|
static void
|
|
dump_symbol_map2( const field_key_t& key, const std::list<size_t>& candidates ) {
|
|
if( !yydebug ) return;
|
|
char *fields = NULL, sep[2] = "";
|
|
|
|
for( auto candidate : candidates ) {
|
|
char *tmp = fields;
|
|
fields = xasprintf("%s%s %3" GCC_PRISZ "u",
|
|
tmp? tmp : "", sep, (fmt_size_t)candidate);
|
|
sep[0] = ',';
|
|
free(tmp);
|
|
}
|
|
|
|
dbgmsg( "%s:%d: %3" GCC_PRISZ "u %s {%s}", __func__, __LINE__,
|
|
(fmt_size_t)key.program, key.name, fields );
|
|
free(fields);
|
|
}
|
|
|
|
void
|
|
dump_symbol_map2() {
|
|
int n = 0;
|
|
for( const auto& elem : symbol_map2 ) {
|
|
const field_key_t& key( elem.first );
|
|
const std::list<size_t>& candidates( elem.second);
|
|
if( key.program != 0 ) {
|
|
dump_symbol_map2( key, candidates );
|
|
n++;
|
|
}
|
|
}
|
|
dbgmsg("symbol_map2 has %d program elements", n);
|
|
}
|
|
|
|
static void
|
|
dump_symbol_map_value( const char name[], const symbol_map_t::value_type& value ) {
|
|
if( !yydebug ) return;
|
|
char *ancestry = NULL, sep[2] = "";
|
|
auto p = value.second.begin();
|
|
|
|
for( ; p != value.second.end(); p++ ) {
|
|
char *tmp = ancestry;
|
|
ancestry = xasprintf("%s%s %3" GCC_PRISZ "u",
|
|
tmp? tmp : "", sep, (fmt_size_t)*p);
|
|
sep[0] = ',';
|
|
free(tmp);
|
|
}
|
|
|
|
dbgmsg( "%s:%d: %s -> %-24s {%s }", __func__, __LINE__,
|
|
name, value.first.c_str(), ancestry );
|
|
free(ancestry);
|
|
}
|
|
|
|
|
|
static void
|
|
dump_symbol_map_value1( const symbol_map_t::value_type& value ) {
|
|
dump_symbol_map_value( "result", value );
|
|
}
|
|
|
|
static symbol_map_t::value_type
|
|
field_structure( symbol_elem_t& sym ) {
|
|
static const symbol_map_t::value_type
|
|
none( symbol_map_t::key_type( 0, "", 0 ), std::vector<size_t>() );
|
|
|
|
if( !is_data_field(sym) ) return none;
|
|
|
|
cbl_field_t *field = cbl_field_of(&sym);
|
|
assert(field->type != FldForward); // eliminated by is_data_field
|
|
|
|
symbol_map_t::key_type key( sym.program, field->name, field->parent );
|
|
symbol_map_t::value_type elem( key, std::vector<size_t>() );
|
|
symbol_map_t::mapped_type& v(elem.second);
|
|
|
|
for( v.push_back(field_index(field)); field->parent > 0; ) {
|
|
symbol_elem_t *par = symbol_at(field->parent);
|
|
|
|
if( SymFile == par->type ) {
|
|
v.push_back(field->parent);
|
|
break;
|
|
}
|
|
assert( SymField == par->type );
|
|
v.push_back(field->parent);
|
|
|
|
field = cbl_field_of(par);
|
|
|
|
// for C of R and B of A, where R redefines B, skip B: vector is [C, R, A].
|
|
cbl_field_t *redefined = symbol_redefines(field); // if R redefines B
|
|
if( redefined ) {
|
|
field = redefined; // We will use B's parent on next iteration
|
|
}
|
|
}
|
|
|
|
return elem;
|
|
}
|
|
|
|
void
|
|
build_symbol_map() {
|
|
static size_t beg = 0;
|
|
size_t end = symbols_end() - symbols_begin();
|
|
|
|
if( beg == end ) return;
|
|
const size_t nsym = end - beg;
|
|
|
|
std::transform( symbols_begin(beg), symbols_end(),
|
|
std::inserter(symbol_map, symbol_map.begin()),
|
|
field_structure );
|
|
beg = end;
|
|
|
|
symbol_map.erase(sym_name_t(""));
|
|
|
|
if( yydebug ) {
|
|
dbgmsg( "%s:%d: " HOST_SIZE_T_PRINT_UNSIGNED " of "
|
|
HOST_SIZE_T_PRINT_UNSIGNED " symbols inserted into "
|
|
HOST_SIZE_T_PRINT_UNSIGNED " in symbol_map",
|
|
__func__, __LINE__, (fmt_size_t)nsym, (fmt_size_t)end,
|
|
(fmt_size_t)symbol_map.size() );
|
|
}
|
|
}
|
|
|
|
bool
|
|
update_symbol_map( symbol_elem_t *e ) {
|
|
auto output = symbol_map.insert(field_structure(*e));
|
|
return output.second;
|
|
}
|
|
|
|
class is_name {
|
|
const char *name;
|
|
public:
|
|
explicit is_name( const char *name ) : name(name) {}
|
|
bool operator()( const symbol_map_t::value_type& elem ) {
|
|
const bool tf = elem.first == name;
|
|
return tf;
|
|
}
|
|
protected:
|
|
void dump_key( const char tag[], const symbol_map_t::key_type& key ) const {
|
|
dbgmsg( "symbol_map key: %s { %3" GCC_PRISZ "u %3" GCC_PRISZ "u %s }",
|
|
tag, (fmt_size_t)key.program, (fmt_size_t)key.parent, key.name );
|
|
}
|
|
};
|
|
|
|
/*
|
|
* Construct a list of ancestors based on a set of candidate groups.
|
|
* Presented with an item, see if any group an ancestor. If so,
|
|
* replace the item's ancestry with the group's ancestry (thus
|
|
* shortening the chain). Otherwise, return an empty element.
|
|
*/
|
|
class reduce_ancestry {
|
|
std::vector<symbol_map_t::mapped_type> candidates;
|
|
static symbol_map_t::mapped_type
|
|
candidates_only( const symbol_map_t::value_type& elem ) { return elem.second; }
|
|
public:
|
|
explicit reduce_ancestry( const symbol_map_t& groups )
|
|
: candidates( groups.size() )
|
|
{
|
|
std::transform( groups.begin(), groups.end(), candidates.begin(),
|
|
candidates_only );
|
|
}
|
|
symbol_map_t::value_type
|
|
reduce( const symbol_map_t::value_type& item ) {
|
|
static symbol_map_t::value_type none( "", std::vector<size_t>() );
|
|
|
|
auto ancestors = candidates.begin();
|
|
for( ; ancestors != candidates.end(); ancestors++ ) {
|
|
assert(!ancestors->empty()); // ancestry always starts with self
|
|
auto p = std::find( item.second.begin(), item.second.end(),
|
|
ancestors->front() );
|
|
if( p != item.second.end() ) {
|
|
// Preserve symbol's index at front of ancestor list.
|
|
symbol_map_t::mapped_type shorter(1 + ancestors->size());
|
|
auto p_l = shorter.begin();
|
|
*p_l = item.second.front();
|
|
shorter.insert( ++p_l, ancestors->begin(), ancestors->end() );
|
|
return make_pair(item.first, shorter);
|
|
}
|
|
}
|
|
return none;
|
|
}
|
|
symbol_map_t::value_type
|
|
operator()( symbol_map_t::value_type item ) { return reduce(item); }
|
|
};
|
|
|
|
class different_program {
|
|
size_t program;
|
|
public:
|
|
explicit different_program( size_t program ) : program(program) {}
|
|
bool operator()( const symbol_map_t::value_type& item ) const {
|
|
return ! item.first.same_program(program);
|
|
}
|
|
};
|
|
|
|
class in_scope {
|
|
size_t program;
|
|
|
|
static size_t prog_of( size_t program ) {
|
|
const cbl_label_t *L = cbl_label_of(symbol_at(program));
|
|
return L->parent;
|
|
}
|
|
|
|
public:
|
|
explicit in_scope( size_t program ) : program(program) {}
|
|
|
|
// A symbol is in scope if it's defined by this program or by an ancestor.
|
|
bool operator()( const symbol_map_t::value_type& item ) const {
|
|
const symbol_elem_t *e = symbol_at(item.second.front());
|
|
for( size_t prog = this->program; prog != 0; prog = prog_of(prog) ) {
|
|
if( e->program == prog ) return true;
|
|
}
|
|
return false;
|
|
}
|
|
};
|
|
|
|
/*
|
|
* For a field symbol and list of qualifier IN/OF names, see if the
|
|
* namelist matches the symbol's name and ancectors' names. Success
|
|
* is all names match within scope.
|
|
*
|
|
* All symbols local to the program are in scope. A containing
|
|
* program's symbol matches only if global_e is set on it or one of
|
|
* its ancestors.
|
|
*/
|
|
static bool
|
|
name_has_names( const symbol_elem_t *e,
|
|
const std::list<const char *>& names, bool in_scope )
|
|
{
|
|
assert( ! names.empty() );
|
|
auto name = names.rbegin();
|
|
|
|
while( e && e->type == SymField ) {
|
|
auto field = cbl_field_of(e);
|
|
if( field->type == FldForward ) return false;
|
|
|
|
if( 0 == strcasecmp(field->name, *name) ) {
|
|
in_scope = in_scope || (field->attr & global_e);
|
|
if( ++name == names.rend() ) break;
|
|
}
|
|
|
|
// first name must match
|
|
if( name == names.rbegin() ) break;
|
|
|
|
// Do not chase redefines if we have an 01 record for an FD.
|
|
if( field->file ) {
|
|
e = symbol_at(field->file);
|
|
assert(1 == field->level);
|
|
assert(e->type == SymFile);
|
|
break;
|
|
}
|
|
|
|
/*
|
|
* If the current field redefines another, it is not a member of
|
|
* its parent, but of its grandparent, if any. Not a loop because
|
|
* REDEFINES cannot be chained.
|
|
*/
|
|
cbl_field_t *parent = symbol_redefines(field);
|
|
if( parent ) {
|
|
field = parent;
|
|
assert( NULL == symbol_redefines(field) );
|
|
}
|
|
|
|
e = field->parent ? symbol_at(field->parent) : NULL;
|
|
}
|
|
|
|
if( e && e->type == SymFile ) {
|
|
// first name can be a filename
|
|
auto file = cbl_file_of(e);
|
|
if( 0 == strcasecmp(file->name, *name) ) name++;
|
|
}
|
|
|
|
return in_scope && name == names.rend();
|
|
}
|
|
|
|
size_t end_of_group( size_t igroup );
|
|
|
|
static std::vector<size_t>
|
|
symbol_match2( size_t program,
|
|
const std::list<const char *>& names, bool local = true )
|
|
{
|
|
std::vector<size_t> fields;
|
|
|
|
field_key_t key(program, names.back());
|
|
|
|
auto plist = symbol_map2.find(key);
|
|
if( plist != symbol_map2.end() ) {
|
|
for( auto candidate : plist->second ) {
|
|
const symbol_elem_t *e = symbol_at(candidate);
|
|
if( name_has_names( e, names, local ) ) {
|
|
fields.push_back( symbol_index(e) );
|
|
}
|
|
}
|
|
}
|
|
|
|
if( fields.empty() ){
|
|
if( program > 0 ) { // try containing program
|
|
program = cbl_label_of(symbol_at(program))->parent;
|
|
return symbol_match2( program, names, program == 0 );
|
|
}
|
|
}
|
|
|
|
if( yydebug ) {
|
|
char *ancestry = NULL;
|
|
const char *sep = "";
|
|
for( auto name : names ) {
|
|
char *partial = ancestry;
|
|
int asret = asprintf(&ancestry, "%s%s%s", partial? partial : "", sep, name);
|
|
assert(asret);
|
|
sep = " -> ";
|
|
assert(ancestry);
|
|
free(partial);
|
|
}
|
|
|
|
if( fields.empty() ) {
|
|
dbgmsg("%s: '%s' matches no fields", __func__, ancestry);
|
|
dump_symbol_map2();
|
|
} else {
|
|
char *fieldstr = NULL;
|
|
sep = "";
|
|
for( auto field : fields ) {
|
|
char *partial = fieldstr;
|
|
int asret = asprintf(&fieldstr, "%s%s" HOST_SIZE_T_PRINT_UNSIGNED,
|
|
partial? partial : "", sep, (fmt_size_t)field);
|
|
assert(asret);
|
|
sep = ", ";
|
|
assert(fieldstr);
|
|
free(partial);
|
|
}
|
|
|
|
dbgmsg("%s: '%s' matches " HOST_SIZE_T_PRINT_UNSIGNED " fields: {%s}",
|
|
__func__, ancestry, (fmt_size_t)fields.size(), fieldstr);
|
|
free(fieldstr);
|
|
}
|
|
free(ancestry);
|
|
}
|
|
|
|
return fields;
|
|
}
|
|
|
|
/*
|
|
* The names list is in top-down order, front-to-back. This function
|
|
* iterates backwards over the list, looking for the parent of N at
|
|
* N-1.
|
|
*/
|
|
static symbol_map_t
|
|
symbol_match( size_t program, const std::list<const char *>& names ) {
|
|
auto matched = symbol_match2( program, names );
|
|
symbol_map_t output;
|
|
|
|
for( auto isym : matched ) {
|
|
auto e = symbol_at(isym);
|
|
auto f = cbl_field_of(e);
|
|
|
|
symbol_map_t::key_type key( e->program, f->name, f->parent );
|
|
auto p = symbol_map.find(key);
|
|
if( p == symbol_map.end() ) {
|
|
yyerror("%s is not defined", key.name);
|
|
continue;
|
|
}
|
|
auto inserted = output.insert(*p);
|
|
if( ! inserted.second ) {
|
|
error_msg_direct("%s is not a unique reference", key.name);
|
|
}
|
|
}
|
|
return output;
|
|
}
|
|
|
|
static const symbol_elem_t * symbol_field_alias_01;
|
|
|
|
const symbol_elem_t *
|
|
symbol_field_alias_begin() {
|
|
return symbol_field_alias_01 = symbol_field_current_record();
|
|
}
|
|
void
|
|
symbol_field_alias_end() {
|
|
symbol_field_alias_01 = NULL;
|
|
}
|
|
|
|
std::pair <symbol_elem_t *, bool>
|
|
symbol_find( size_t program, std::list<const char *> names ) {
|
|
symbol_map_t items = symbol_match(program, names);
|
|
|
|
if( symbol_field_alias_01 && items.size() != 1 ) {
|
|
symbol_map_t qualified;
|
|
size_t i01( symbol_index(symbol_field_alias_01) );
|
|
std::copy_if( items.begin(), items.end(),
|
|
std::inserter(qualified, qualified.begin()),
|
|
[i01]( auto item ) {
|
|
const std::vector<size_t>& ancestors(item.second);
|
|
return ancestors.back() == i01;
|
|
} );
|
|
items = qualified;
|
|
}
|
|
|
|
auto unique = items.size() == 1;
|
|
|
|
if( ! unique ) {
|
|
if( items.empty() ) {
|
|
return std::pair<symbol_elem_t *, bool>(NULL, false);
|
|
}
|
|
if( yydebug ) {
|
|
dbgmsg( "%s:%d: '%s' has " HOST_SIZE_T_PRINT_UNSIGNED " possible matches",
|
|
__func__, __LINE__, names.back(), (fmt_size_t)items.size() );
|
|
std::for_each( items.begin(), items.end(), dump_symbol_map_value1 );
|
|
}
|
|
}
|
|
|
|
size_t isym = items.begin()->second.front();
|
|
auto output = std::make_pair(symbol_at(isym), unique);
|
|
|
|
assert( FldForward != field_at(isym)->type );
|
|
|
|
return output;
|
|
}
|
|
|
|
class in_group {
|
|
size_t group;
|
|
public:
|
|
explicit in_group( size_t group ) : group(group) {}
|
|
|
|
bool operator()( symbol_map_t::const_reference elem ) const {
|
|
return 0 < std::count( elem.second.begin(),
|
|
elem.second.end(), this->group );
|
|
}
|
|
};
|
|
|
|
symbol_elem_t *
|
|
symbol_find_of( size_t program, std::list<const char *> names, size_t group ) {
|
|
symbol_map_t input = symbol_match(program, names);
|
|
|
|
symbol_map_t items;
|
|
std::copy_if( input.begin(), input.end(),
|
|
std::inserter(items, items.begin()), in_group(group) );
|
|
|
|
if( items.size() == 1 ) {
|
|
size_t isym = items.begin()->second.front();
|
|
assert( FldForward != field_at(isym)->type );
|
|
return symbol_at(isym);
|
|
}
|
|
|
|
if( yydebug ) {
|
|
dbgmsg( "%s:%d: '%s' has " HOST_SIZE_T_PRINT_UNSIGNED " possible matches",
|
|
__func__, __LINE__, names.back(), (fmt_size_t)input.size() );
|
|
std::for_each( input.begin(), input.end(), dump_symbol_map_value1 );
|
|
}
|
|
|
|
return NULL;
|
|
}
|