#else
#define _CBLDIAG_H
+#if 0
+#define gcobol_getenv(x) getenv(x)
+#else
+#define gcobol_getenv(x) ((char *)nullptr)
+#endif
+
const char * cobol_filename();
/*
static void
location_dump( const char func[], int line, const char tag[], const LOC& loc) {
extern int yy_flex_debug;
- if( yy_flex_debug && getenv("update_location") )
+ if( yy_flex_debug && gcobol_getenv("update_location") )
fprintf(stderr, "%s:%d: %s location (%d,%d) to (%d,%d)\n",
func, line, tag,
loc.first_line, loc.first_column, loc.last_line, loc.last_column);
turns.location,
elem.first, files);
}
- if( getenv("SHOW_PARSE") ) enabled_exceptions.dump();
+ if( getenv("GCOBOL_SHOW") ) enabled_exceptions.dump();
return true;
}
%}
cobol_set_debugging( false, false, false );
- copybook_directory_add( getenv("GCOB_COPYBOOK") );
+ copybook_directory_add( getenv("GCOBOL_COPYBOOK") );
}
static unsigned int
void
declarative_runtime_match( cbl_field_t *declaratives, cbl_label_t *lave ) {
- if( getenv("SHOW_PARSE") )
+ if( getenv("GCOBOL_SHOW") )
{
fprintf(stderr, "( %d ) %s: \n", cobol_location().first_line, __func__);
}
- if( getenv("TRACE1") )
+ if( getenv("GCOBOL_TRACE") )
{
gg_printf(">>>>>>( %d )(%s) declaratives:%s lave:%s\n",
build_int_cst_type(INT, cobol_location().first_line),
static bool suppress_cobol_entry_point = false;
static char ach_cobol_entry_point[256] = "";
-bool bSHOW_PARSE = getenv("SHOW_PARSE");
+bool bSHOW_PARSE = getenv("GCOBOL_SHOW");
bool show_parse_sol = true;
int show_parse_indent = 0;
trace_handle = gg_define_variable(INT, "trace_handle", vs_static);
trace_indent = gg_define_variable(INT, "trace_indent", vs_static);
- bTRACE1 = getenv("TRACE1") ? getenv("TRACE1") : gv_trace_switch;
+ bTRACE1 = getenv("GCOBOL_TRACE") ? getenv("GCOBOL_TRACE") : gv_trace_switch;
if( bTRACE1 && strcmp(bTRACE1, "0") != 0 )
{
}
gg_assign(base, gg_cast(UCHAR_P, parameter));
- IF( gg_call_expr( CHAR_P,
- "getenv",
- gg_string_literal("PARAMETERS_ON_ENTRY"),
- NULL_TREE),
- ne_op,
- gg_cast(CHAR_P, null_pointer_node));
- {
- gg_printf("parameter_on_entry: %s(): %d %p\n",
- gg_string_literal(current_function->our_unmangled_name),
- build_int_cst_type(INT, i+1),
- base,
- NULL_TREE);
- }
- ELSE
- ENDIF
-
if( args[i].refer.field->attr & any_length_e )
{
// gg_printf("side channel: Length of \"%s\" is %ld\n",
sprintf(ach, "__gg__%s", mname);
free(mname);
- if( getenv("SHOW_GLOBAL_VARIABLES") )
- {
- char ach_type[32];
- strcpy(ach_type, cbl_field_type_str(new_var->type));
-
- fprintf(stderr, "struct cblc_field_t %s = {\n", ach);
- fprintf(stderr, " .data = NULL ,\n" );
- fprintf(stderr, " .capacity = %d ,\n", new_var->data.capacity );
- fprintf(stderr, " .offset = %ld ,\n" , new_var->offset );
- fprintf(stderr, " .name = \"%s\" ,\n" , new_var->name );
- fprintf(stderr, " .picture = \"%s\" ,\n" , new_var->data.picture ? new_var->data.picture : "" );
- if( new_var->data.initial || new_var->type == FldPointer )
- {
- fprintf(stderr, " .initial = \"%s\" ,\n" , new_var->data.picture ? new_var->data.picture : "" );
- }
- else
- {
- fprintf(stderr, " .initial = NULL ,\n" );
- }
- fprintf(stderr, " .parent = NULL,\n" );
- fprintf(stderr, " .depending_on = NULL ,\n" );
- fprintf(stderr, " .depends_on = NULL ,\n" );
- fprintf(stderr, " .occurs_lower = 0 ,\n" );
- fprintf(stderr, " .occurs_upper = 0 ,\n" );
- fprintf(stderr, " .attr = 0x%lx ,\n" , new_var->attr );
- fprintf(stderr, " .type = %s ,\n" , ach_type);
- fprintf(stderr, " .level = %d ,\n" , new_var->level );
- fprintf(stderr, " .digits = %d ,\n" , new_var->data.digits );
- fprintf(stderr, " .rdigits = %d ,\n" , new_var->data.rdigits );
- fprintf(stderr, " };\n");
- }
-
if( strcmp(new_var->name, "_VERY_TRUE") == 0 )
{
new_var->var_decl_node = boolean_true_node;
dbgmsg("flex input buffer: '%.*s'\n[xelf]", int(pos - data), data);
}
void dump() const {
+#ifdef GETENV_OK
if( getenv("lexer_input") ) show();
+#endif
}
};
class dump_loc_on_exit {
public:
dump_loc_on_exit() {
- if( getenv( "update_yylloc" ) )
+ if( gcobol_getenv( "update_yylloc" ) )
location_dump( "update_yylloc", __LINE__, "begin", yylloc);
}
~dump_loc_on_exit() {
- if( getenv( "update_yylloc" ) )
+ if( gcobol_getenv( "update_yylloc" ) )
location_dump( "update_yylloc", __LINE__, "end ", yylloc);
}
} dloe;
data_descr: data_descr1
{
$$ = current_field($1); // make available for occurs, etc.
- char *env = getenv("symbols_update");
- if( env && env[0] == 'P' ) {
- dbgmsg("parse.y:%d: %-15s %s (%s)", __LINE__,
- cbl_field_type_str($$->type) + 3,
- field_str($$),
- cbl_field_type_str($$->usage) + 3);
- }
}
| error { static cbl_field_t none = {}; $$ = &none; }
;
parser_symbol_add(name.field);
}
- if( getenv("ast_call") ) {
- dbgmsg("%s: calling %s returning %s with %zu args:", __func__,
- name_of(name.field),
- (returning.field)? returning.field->name : "[none]",
- narg);
- for( size_t i=0; i < narg; i++ ) {
- const char *crv = "?";
- switch(args[i].crv) {
- case by_default_e: crv = "def"; break;
- case by_reference_e: crv = "ref"; break;
- case by_content_e: crv = "con"; break;
- case by_value_e: crv = "val"; break;
- }
- dbgmsg("%s: %4zu: %s @%p %s", __func__,
- i, crv, args[i].refer.field, args[i].refer.field->name);
- }
- }
parser_call( name, returning, narg, args, except, not_except, is_function );
}
assert( !(p->type == LblSection && p->parent > 0) );
- if( getenv(__func__) ) {
- yywarn("%s: added label %3zu %10s for '%s' of %zu", __func__,
- symbol_elem_of(p) - symbols_begin(), p->type_str()+3, p->name, p->parent);
- }
-
return p;
}
strcpy(label.name, name);
if( label.type == LblNone ) assert(label.parent == 0);
- const symbol_elem_t *last = symbols_end();
-
p = symbol_label_add(PROGRAM, &label);
assert(p);
const char *sect_name = section? cbl_label_of(symbol_at(section))->name : NULL;
procedure_reference_add(sect_name, p->name, yylineno, current.program_section());
- if( getenv(__func__) ) {
- yywarn("%s: %s label %3zu %10s for '%s' of %zu", __func__,
- symbols_end() == last? "added" : "found",
- symbol_index(symbol_elem_of(p)), p->type_str()+3, p->name, p->parent);
- }
-
return p;
}
pC = use_any(arith->tgts, C);
pA = use_any(arith->A, A);
- if( getenv(__func__) ) {
- dbgmsg("%s:%d: %-12s C{%zu %p} A{%zu %p}", __func__, __LINE__,
- arith->format_str(), nC, pC, nA, pA );
- }
parser_add( nC, pC, nA, pA, arith->format, arith->on_error, arith->not_error );
ec_type_t handled = arith->on_error || arith->not_error ? ec_size_e : ec_none_e;
}
assert( inputs->lists.back().marker );
std::copy( inputs->lists.begin(), inputs->lists.end(), sources.begin() );
- if( yydebug && getenv(__func__) ) {
- std::for_each(sources.begin(), sources.end(), stringify_src_t::dump);
- }
parser_string( into, pointer, sources.size(), sources.data(), on_error, not_error );
}
} else {
parser_move(tgt, src, current_rounded_mode());
}
- if( getenv(__func__) ) {
- yywarn("%s:%-5s: %s", __func__, keyword_str(token), field_str(tgt.field));
- }
return true;
}
parser_initialize(tgt);
}
}
-
- if( getenv(__func__) ) {
- yywarn("%s: value: %s", __func__, field_str(tgt.field));
- }
}
// apply REPLACING, possibly overwriting VALUE
if( r != replacements.end() ) {
parser_move( tgt, *r->second );
- if( getenv(__func__) ) {
- cbl_field_t *from = r->second->field;
- char from_str[128]; // copy static buffer from field_str
- strcpy( from_str, field_str(from) );
- yywarn("%s: move: %-18s %s \n\t from %-18s %s", __func__,
- cbl_field_type_str(tgt.field->type) + 3, field_str(tgt.field),
- cbl_field_type_str(from->type) + 3, from_str);
- }
return true;
}
return true;
-
}
typedef std::pair<cbl_field_t*,cbl_field_t*> field_span_t;
typedef std::pair<size_t, size_t> cbl_bytespan_t;
-static void
-dump_spans( size_t isym,
- const cbl_field_t *table,
- const std::list<field_span_t>& spans,
- size_t nrange,
- const cbl_bytespan_t ranges[],
- size_t depth,
- const std::list<cbl_subtable_t>& subtables )
-{
- int i=0;
- assert( nrange == 0 || nrange == spans.size() );
-
- if( isym != field_index(table) ) {
- dbgmsg("%s:%d: isym %zu is not #%zu %02u %s", __func__, __LINE__,
- isym, field_index(table), table->level, table->name);
- }
- dbgmsg( "%s: [%zu] #%zu %s has %zu spans and %zu subtables",
- __func__, depth, isym, table->name, nrange, subtables.size() );
- for( auto span : spans ) {
- unsigned int last_level = 0;
- const char *last_name = "<none>";
- if( span.second ) {
- last_level = span.second->level;
- last_name = span.second->name;
- }
-
- char at_subtable[64] = {};
- size_t offset = nrange? ranges[i].first : 0;
- auto p = std::find_if(subtables.begin(), subtables.end(),
- [offset]( const cbl_subtable_t& tbl ) {
- return tbl.offset == offset;
- });
- if( p != subtables.end() ) {
- sprintf(at_subtable, "(subtable #%zu)", p->isym);
- }
- dbgmsg("\t %02u %-20s to %02u %-20s: %3zu-%zu %s",
- span.first->level, span.first->name,
- last_level, last_name,
- nrange? ranges[i].first : 1,
- nrange? ranges[i].second : 0,
- at_subtable);
- i++;
- }
- if( ! subtables.empty() ) {
- dbgmsg("\ttable #%zu has %zu subtables", isym, subtables.size());
- for( auto tbl : subtables ) {
- dbgmsg("\t #%zu @ %4zu", tbl.isym, tbl.offset);
- }
- }
-}
-
/*
* After the 1st record is initialized, copy it to the others.
*/
size_t nspan, const cbl_bytespan_t spans[],
const std::list<cbl_subtable_t>& subtables )
{
- if( getenv("initialize_statement") ) {
- dbgmsg("%s:%d: %s ", __func__, __LINE__, target.refer.str());
- }
assert( target.refer.nsubscript == dimensions(target.refer.field) );
const cbl_refer_t& src( target.refer );
size_t n( src.field->occurs.ntimes());
const category_map_t& replacements,
size_t depth = 0 )
{
- if( getenv(__func__) ) {
- dbgmsg("%s:%d: %2zu: %s (%s%zuR)",
- __func__, __LINE__, depth, target.refer.str(),
- with_filler? "F" : "",
- replacements.size());
- }
const cbl_refer_t& tgt( target.refer );
assert(dimensions(tgt.field) == tgt.nsubscript || 0 < depth);
assert(!is_literal(tgt.field));
return std::make_pair(first, second);
} );
}
- if( getenv("initialize_statement") ) {
- dump_spans( field_index(output.refer.field), output.refer.field,
- field_spans, ranges.size(), ranges.data(), depth, subtables );
- }
return initialize_table( output, nrange, ranges.data(), subtables );
}
}
initialize_statement( std::list<cbl_num_result_t>& tgts, bool with_filler,
data_category_t value_category,
const category_map_t& replacements) {
- if( yydebug && getenv(__func__) ) {
- yywarn( "%s: %zu targets, %s filler",
- __func__, tgts.size(), with_filler? "with" : "no");
- for( auto tgt : tgts ) {
- fprintf( stderr, "%28s: %s\n", __func__, name_of(tgt.refer.field) );
- }
- for( const auto& elem : replacements ) {
- fprintf( stderr, "%28s: %s <-%s\n", __func__,
- data_category_str(elem.first),
- name_of(elem.second->field) );
- }
- }
bool is_refmod = std::any_of( tgts.begin(), tgts.end(),
[]( const auto& tgt ) {
const char *extant = tmpstring == NULL ? "" : tmpstring;
char *s = xasprintf("%s%.*s", extant, len, yytext);
free(tmpstring);
- if( yy_flex_debug && getenv(__func__) ) {
- yywarn("%s: value is now '%s'", __func__, s);
- }
return tmpstring = s;
}
// SHOW_PARSE must be followed by a bracketed set of instructions, no semicolon
-// This construction isn't really necessary; getenv() apparently runs pretty
-// fast. But using makes compiling a large number of programs just perceptably
-// quicker. So, I am using it; it's cheap.
extern bool bSHOW_PARSE;
extern bool show_parse_sol;
extern int show_parse_indent;
const cbl_special_name_t& elem ) {
const bool matched = key.id == elem.id || 0 == strcasecmp(key.name, elem.name);
- if( getenv(__func__) ) {
- dbgmsg("%s:%d: key: id=%2d, %s", __func__, __LINE__, key.id, key.name);
- dbgmsg("%s:%d: elem: id=%2d, %s => %s", __func__, __LINE__,
- elem.id, elem.name, matched? "match" : "no match");
- }
-
return matched;
}
uint32_t offset = cbl_field_of(block)->offset;
const uint32_t block_level = cbl_field_of(block)->level;
- if( getenv(__func__) ) {
- cbl_field_t *field = cbl_field_of(block);
- dbgmsg( "%s: offset is %3zu for %2u %-30s #%3zu P%zu",
- __func__, field->offset, field->level, field->name,
- symbol_index(block), field->parent );
- }
-
struct symbol_elem_t *e = block;
for( ++e; e < symbols_end(); e++ ) {
if( e->type != SymField ) {
offset += field_memsize(field);
}
- if( getenv(__func__) ) {
- dbgmsg( "%s: offset is %3zu for %2u %-30s #%3zu P%zu",
- __func__, field->offset, field->level, field->name,
- symbol_index(e), field->parent );
- }
-
if( field->type == FldGroup ) {
e = update_block_offsets(e) - 1;
}
// Return OCCURS DEPENDING ON table subordinate to field, if any.
struct cbl_field_t *
symbol_find_odo( cbl_field_t * field ) {
- if( getenv(__func__) ) return symbol_find_odo_debug(field);
size_t bog = field_index(field), eog = end_of_group(bog);
auto e = std::find_if( symbol_at(bog), symbol_at_impl(eog, true), has_odo );
return e == symbol_at_impl(eog, true)? NULL : cbl_field_of(e);
// Print accumulating details for one group to debug log.
bool details = false;
- if( yydebug ) {
- const auto details_for = getenv("symbols_update");
- details = details_for && 0 == strcasecmp(details_for, group->name);
- }
// At end of group, members is a list of all immediate children, any
// of which might have been redefined and so acquired a memsize.
if( e->type != SymField ) {
continue;
}
- const struct cbl_field_t *field = cbl_field_of(e);
-
- if( getenv(__func__) ) {
- if( e == block ) {
- static const char ds[] = "--------------------------------";
- dbgmsg( "%17s %-3s %-3s %-18s %-3s %3s %-16s C/D/R = init\n"
- "%.25s %-.3s %-.3s %-.18s %-.3s %.3s %-.16s %-.7s %-.16s",
- "", "ndx", "off", "type", "par", "lvl", "name",
- ds, ds, ds, ds, ds, ds, ds, ds, ds );
- }
- dbgmsg( "%s:%d: %3zu %3zu %-18s %3zu %02d %-16s %2u/%u/%d = '%s'",
- __func__, __LINE__, e - symbols.elems, field->offset,
- cbl_field_type_str(field->type),
- field->parent, field->level, field->name,
- field->data.capacity, field->data.digits, field->data.rdigits,
- field->data.initial? field->data.initial : "(none)" );
- }
}
}
return os << bound.lower << ',' << bound.upper;
}
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wunused-function"
+// Keep this debugging function around for when it is needed
static std::ostream&
operator<<( std::ostream& os, const cbl_field_data_t& field ) {
return os << field.memsize << ','
<< ',' << field.line
<< ',' << field.data;
}
-
-static void
-write_field_csv( size_t isym, const cbl_field_t *field ) {
- static std::ofstream os( getenv("GCOBOL_DATA") );
- assert(os.is_open());
-
- if( symbols.first_program < isym) {
- os << isym << "," << *field << std::endl;
- }
-}
+#pragma GCC diagnostic pop
static std::map<size_t, std::set<size_t>> same_record_areas;
size_t parse_error_count();
struct symbol_elem_t *p, *pend;
std::list<cbl_field_t*> shared_record_areas;
- if( getenv(__func__) ) {
- fprintf(stderr, "Initial");
- symbols_dump(std::max(first, symbols.first_program), true);
- }
-
for( p = symbols_begin(first); p < symbols_end(); p++ ) {
if( p->type == SymAlphabet ) continue; // Alphabets already processed.
// no special processing for other levels
}
- if( getenv("GCOBOL_DATA") ) {
- write_field_csv( p - symbols_begin(), field );
- }
-
// Update ODO field in situ.
if( is_table(field) ) {
size_t& odo = field->occurs.depending_on;
assert( !(field->data.memsize > 0 && symbol_explicitly_redefines(field)) );
}
- if( getenv(__func__) ) {
- fprintf(stderr, "Pre");
- symbols_dump(std::max(first, symbols.first_program), true);
- }
-
// A shared record area has no 01 child because that child redefines its parent.
for( auto sharer : shared_record_areas ) {
auto redefined = cbl_field_of(symbol_at(sharer->parent));
symbols.registers.return_code = symbol_index(symbol_field(0,0, "RETURN-CODE"));
symbols.registers.very_true = symbol_index(symbol_field(0,0, "_VERY_TRUE"));
symbols.registers.very_false = symbol_index(symbol_field(0,0, "_VERY_FALSE"));
-
- if( getenv(__func__) ) symbols_dump(0, true);
}
/*
}
}
- char *s;
- if( (s = getenv(__func__)) != NULL ) {
- if( s[0] == 'D' ) {
- for( struct symbol_elem_t *e = symbols_begin(); e < symbols_end(); e++ ) {
- fprintf(stderr, "%zu: %s ", e - symbols.elems, symbol_type_str(e->type));
- if( e->type == SymField ) {
- fprintf(stderr, "%s = %s",
- cbl_field_of(e)->name, cbl_field_of(e)->data.initial);
- }
- fprintf(stderr, "\n");
- }
- }
-
- dbgmsg( "%s:%d: %3zu %-18s %02d %-16s %u/%u/%d = '%s'", __func__, __LINE__,
- field->offset,
- cbl_field_type_str(field->type), field->level, field->name,
- field->data.capacity, field->data.digits, field->data.rdigits,
- field->data.initial? field->data.initial : "(none)" );
- }
-
if( is_forward(field) ) {
auto *e = symbol_field( program, field->parent, field->name );
if( e ) {
output.min = cbl_field_of(&*p.first)->data.capacity;
output.max = cbl_field_of(&*p.second)->data.capacity;
- if( yydebug && getenv(__func__) ) {
- dbgmsg("%s: %s: min '%s' %zu, max '%s' %zu", __func__, file->name,
- cbl_field_of(&*p.first)->name, output.min,
- cbl_field_of(&*p.second)->name, output.max);
- }
-
assert(output.min > 0 && "min record size is 0");
assert(output.min <= output.max);
snprintf(f->name, sizeof(f->name), "_literal%d",++nliteral);
} else {
snprintf(f->name, sizeof(f->name), "_stack%d",++nstack);
-
- if( getenv("symbol_temporaries_free") ) {
- dbgmsg("%s: %s, %s", __func__, f->name, 3 + cbl_field_type_str(f->type));
- }
}
return f;
}
temporaries_t::~temporaries_t() {
- if( getenv( "symbol_temporaries_free" ) ) {
- dbgmsg("%s: %zu literals", __func__, literals.size());
- for( const auto& elem : literals ) {
- const literal_an& key(elem.first);
- fprintf(stderr, "%c '%s'\n", key.is_quoted? 'Q' : ' ', key.value.c_str());
- }
- dump();
- }
}
cbl_field_t *
void
symbol_temporaries_free() {
- if( getenv(__func__) ) temporaries.dump();
for( auto& elem : temporaries.used ) {
const cbl_field_type_t& type(elem.first);
temporaries_t::fieldset_t& used(elem.second);
yywarn("failed iconv_open tocode = '%s' fromcode = %s", tocode, fromcode);
}
- // Sat Mar 16 11:45:08 2024: require temporary environment for testing
- if( getenv( "INTERNALIZE_NO") ) return data.initial;
-
bool using_assumed = fromcode == os_locale.assumed;
if( fromcode == tocode || has_attr(hex_encoded_e) ) {
if( 0 != memcmp(data.initial, output.data(), out - output.data()) ) {
assert(out <= output.data() + data.capacity);
- if( getenv(__func__) ) {
- const char *eoi = data.initial + data.capacity, *p;
- char nullitude[64] = "no null";
- if( (p = std::find(data.initial, eoi, '\0')) != eoi ) {
- sprintf(nullitude, "NUL @ %zu", p - data.initial);
- }
- dbgmsg("%s:%d: before: %-15s %-20s: '%.*s'{%u}, %s", __func__, __LINE__,
- 3 + cbl_field_type_str(type), name,
- data.capacity, data.initial, data.capacity, nullitude);
- }
dbgmsg("%s: converted '%.*s' to %s",
__func__, data.capacity, data.initial, tocode);
free(const_cast<char*>(data.initial));
data.initial = mem;
-
- if( getenv(__func__) ) {
- const char *eoi = data.initial + data.capacity, *p;
- char nullitude[64] = "no null";
- if( (p = std::find(data.initial, eoi, '\0')) != eoi ) {
- sprintf(nullitude, "NUL @ %zu", p - data.initial);
- }
- dbgmsg("%s:%d: after: %-15s %-20s: '%.*s'{%u}, %s", __func__, __LINE__,
- "", name,
- data.capacity, data.initial, data.capacity, nullitude);
- }
-
}
return data.initial;
cbl_label_t *
symbol_label_add( size_t program, cbl_label_t *input )
{
- if( getenv(__func__) ) {
- const cbl_label_t *L = input;
- dbgmsg( "%s:%d: %-5s #%3zu %-9s '%s' of '%s' at line %d", __func__, __LINE__,
- "input",
- size_t(0),
- L->type_str()+3,
- L->name,
- L->parent? cbl_label_of(symbol_at(L->parent))->name : "",
- L->line );
- }
-
cbl_label_t *label = symbol_label(program, input->type,
input->parent, input->name);
if( label && label->type == LblNone ) {
- const char *verb = "set";
label->type = input->type;
label->parent = input->parent;
label->line = input->line;
- if( getenv(__func__) ) {
- const cbl_label_t *L = label;
- dbgmsg( "%s:%d: %-5s #%3zu %-9s '%s' of '%s' at line %d",
- __func__, __LINE__,
- verb,
- symbol_elem_of(L) - symbols_begin(),
- L->type_str()+3,
- L->name,
- L->parent? cbl_label_of(symbol_at(L->parent))->name : "",
- L->line );
- }
return label;
}
// restore munged line number unless symbol_add returned an existing label
if( e->elem.label.line < 0 ) e->elem.label.line = -e->elem.label.line;
- if( getenv(__func__) ) {
- const cbl_label_t *L = cbl_label_of(e);
- dbgmsg( "%s:%d: added #%3zu %-9s '%s' of '%s' at line %d", __func__, __LINE__,
- e - symbols_begin(),
- L->type_str()+3,
- L->name,
- L->parent? cbl_label_of(symbol_at(L->parent))->name : "",
- L->line );
- }
symbols.labelmap_add(e);
return cbl_label_of(e);
}
struct symbol_elem_t *e = symbol_special(program, special->name);
if( e ) {
- cbl_special_name_t *s = cbl_special_name_of(e);
- if( getenv(__func__) ) {
- dbgmsg("%s:%d matches %s %d (%s)", __func__, __LINE__,
- special->name, int(s->id), s->name);
- }
return e;
}
assert(e == NULL);
cbl_errx( "%s:%d: could not add '%s'", __func__, __LINE__, special->name);
}
- if( getenv(__func__) ) {
- dbgmsg( "%s:%d: added special '%s'", __func__, __LINE__,
- e->elem.special.name);
- }
-
elem_key_t key(program, cbl_special_name_of(e)->name);
symbols.specials[key] = symbol_index(e);
static const symbol_map_t::value_type
none( symbol_map_t::key_type( 0, "", 0 ), std::vector<size_t>() );
- if( getenv(__func__) && sym.type == SymField ) {
- const auto& field = *cbl_field_of(&sym);
- dbgmsg("%s: #%zu %s: '%s' is_data_field: %s", __func__,
- symbol_index(&sym), cbl_field_type_str(field.type), field.name,
- is_data_field(sym)? "yes" : "no" );
- }
if( !is_data_field(sym) ) return none;
cbl_field_t *field = cbl_field_of(&sym);
}
}
- if( getenv(__func__) && yydebug ) {
- dbgmsg( "%s:%d: '%s' has %zu ancestors", __func__, __LINE__,
- elem.first.c_str(), elem.second.size() );
- dump_symbol_map_value(__func__, elem);
- }
-
return elem;
}
if( yydebug ) {
dbgmsg( "%s:%d: %zu of %zu symbols inserted into %zu in symbol_map",
__func__, __LINE__, nsym, end, symbol_map.size() );
-
- if( getenv(__func__) ) {
- for( const auto& elem : symbol_map ) {
- dump_symbol_map_value1(elem);
- }
- }
}
}
is_name( const char *name ) : name(name) {}
bool operator()( symbol_map_t::value_type& elem ) {
const bool tf = elem.first == name;
- if( tf && getenv("is_name") ) {
- dump_key( "matched", elem.first );
- }
return tf;
}
protected:
symbol_find_of( size_t program, std::list<const char *> names, size_t group ) {
symbol_map_t input = symbol_match(program, names);
- if( getenv(__func__) && input.size() != 1 ) {
- dbgmsg( "%s:%d: '%s' has %zu candidates for group %zu",
- __func__, __LINE__, names.back(), input.size(), group );
- std::for_each( input.begin(), input.end(), dump_symbol_map_value1 );
- }
-
symbol_map_t items;
std::copy_if( input.begin(), input.end(),
std::inserter(items, items.begin()), in_group(group) );
}
}
- if( yydebug && getenv(__func__) ) {
- dbgmsg("%s:%d: ok to move %s to %s (0x%02x)", __func__, __LINE__,
- cbl_field_type_str(src->type), cbl_field_type_str(tgt->type),
- retval);
- }
-
return retval;
}
const char *section_name = ref.has_section()? ref.section() : key.section();
procref_base_t full_ref(section_name, ref.paragraph());
- if( getenv(__func__) ) {
- dbgmsg("%s: %zu for ref %s of '%s' (line %d) "
- "in %s of '%s' (as %s of '%s')", __func__,
- procedures.count(full_ref),
- ref.paragraph(), ref.section(), ref.line_number(),
- key.paragraph(), key.section(),
- full_ref.paragraph(), full_ref.section() );
- }
-
return 1 == procedures.count(full_ref);
}
}
procdef_t key( section_name, paragraph_name, isym );
- if( getenv(__func__) ) {
- dbgmsg("%s: #%3zu %s of %s", __func__, isym, paragraph_name, section_name);
- }
current_procedure =
programs[program].insert( make_pair(key, procedures_t::mapped_type()) );
}
procedure_reference_add( const char *section, const char *paragraph,
int line, size_t context )
{
- if( getenv(__func__) ) {
- dbgmsg("%s: line %3d %s of %s", __func__, line, paragraph, section);
- }
current_procedure->second.push_back( procref_t(section, paragraph,
line, context) );
}
ambiguous = find_if_not( proc.second.begin(), proc.second.end(),
is_unique(program, proc.first) );
if( proc.second.end() != ambiguous ) {
- if( yydebug || getenv("symbol_label_add")) {
+ if( yydebug ) {
dbgmsg("%s: %s of '%s' has %zu potential matches", __func__,
ambiguous->paragraph(), ambiguous->section(),
procedures.count(*ambiguous));
input_filename_vestige = name;
bool pushed = input_filenames.push( input_file_t(name, inode, 1, lines) );
input_filenames.top().lineno = yylineno = 1;
- if( getenv(__func__) ) {
- dbgmsg(" saving %s with lineno as %d",
- input_filenames.top().name, input_filenames.top().lineno);
- }
return pushed;
}
if( input_filenames.empty() ) return NULL;
auto& input( input_filenames.top() );
input.lineno = yylineno;
- if( getenv(__func__) ) {
- dbgmsg(" setting %s with lineno as %d", input.name, input.lineno);
- }
return input.name;
}
input.lines = linemap_add(line_table, LC_LEAVE, sysp, NULL, 0);
yylineno = input.lineno;
- if( getenv("cobol_filename") ) {
- dbgmsg("restoring %s with lineno to %d", input.name, input.lineno);
- }
return input.name;
}
input_file_t input_file( filename, ino_t(0), fileline ); // constructor sets inode
- if( getenv(__func__) ) return filename; // ignore #line directive
-
if( input_filenames.empty() ) {
input_file.lines = linemap_add(line_table, LC_ENTER, sysp, filename, 1);
input_filenames.push(input_file);
*> { dg-do run }
- *> { dg-set-target-env-var COB_CURRENT_DATE "2020/06/12 18:45:22" }
+ *> { dg-set-target-env-var GCOBOL_CURRENT_DATE "2020/06/12 18:45:22" }
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
*> { dg-do run }
- *> { dg-set-target-env-var COB_CURRENT_DATE "2015/04/05 18:45:22" }
+ *> { dg-set-target-env-var GCOBOL_CURRENT_DATE "2015/04/05 18:45:22" }
*> { dg-output-file "group2/ACCEPT_FROM_TIME___DATE___DAY___DAY-OF-WEEK__2_.out" }
IDENTIFICATION DIVISION.
01 minus10 pic s99 value -10.
- 01 forced_date_n pic X(64) VALUE Z"COB_CURRENT_DATE".
+ 01 forced_date_n pic X(64) VALUE Z"GCOBOL_CURRENT_DATE".
01 forced_date_v pic X(64) VALUE Z"1945/06/01 12:34:56".
procedure division.
file->supplemental = NULL;
}
-static void
-report_open_failure(const char *type,
- const char *structure_name,
- const char *filename)
- {
- bool quiet = true;
- if( !quiet )
- {
- if( getenv(filename) )
- {
- fprintf(stderr,
- "Trying to 'OPEN %s %s %s -> \"%s\"', which doesn't exist\n",
- type,
- structure_name,
- filename,
- getenv(filename));
- }
- else
- {
- fprintf(stderr,
- "Trying to 'OPEN %s %s \"%s\"', which doesn't exist\n",
- type,
- structure_name,
- filename);
- }
- }
- }
-
extern "C"
void
__gg__file_reopen(cblc_file_t *file, int mode_char)
}
else
{
- report_open_failure("INPUT", file->name, trimmed_name);
file->io_status = FsNoFile; // "35"
goto done;
}
else
{
// Trying to extend a non-optional non-existing file is against the rules
- report_open_failure("EXTEND", file->name, trimmed_name);
file->io_status = FsNoFile; // "35"
goto done;
}
}
else
{
- report_open_failure("I-O", file->name, trimmed_name);
file->io_status = FsNoFile; // "35"
goto done;
}
return p;
}
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wunused-function"
+// Keep this debugging function around for when it is needed
static const char *
local_ec_type_str( ec_type_t type ) {
if( type == ec_none_e ) return "EC-NONE";
auto p = local_ec_type_descr(type);
return p->name;
}
+#pragma GCC diagnostic pop
ec_status_t& ec_status_t::update() {
handled = ec_type_t(__gg__exception_handled);
snprintf(statement, sizeof(statement), "%s", __gg__exception_statement);
}
- if( type != ec_none_e && getenv("match_declarative") ) {
- warnx( "ec_status_t::update:%d: EC %s by %s handled %02X " , __LINE__,
- local_ec_type_str(type),
- __gg__exception_statement? statement : "<none>",
- handled ); // might be file-status, not ec_type_t
- }
-
return *this;
}
void
__gg__clock_gettime(clockid_t clk_id, struct timespec *tp)
{
- const char *p = getenv("COB_CURRENT_DATE");
+ const char *p = getenv("GCOBOL_CURRENT_DATE");
if( p )
{
bool operator()( const cbl_declarative_t& dcl ) {
- if( getenv("match_declarative") && oops.type) {
- warnx("match_file_declarative: checking: oops %s dcl %s (handled %s) ",
- local_ec_type_str(oops.type),
- local_ec_type_str(dcl.type),
- local_ec_type_str(handled_type));
- }
-
// Declarative is for the raised exception and not handled by the statement.
if( handled() ) return false;
bool matches = enabled_ECs.match(dcl.type);
}
}
- if( matches && getenv("match_declarative") ) {
- warnx(" matches exception %s (file %zu mode %s)",
- local_ec_type_str(oops.type),
- oops.file,
- cbl_file_mode_str(oops.mode));
- }
-
return matches;
}
};
p = std::find_if( dcls + 1, eodcls, [ec] (const cbl_declarative_t& dcl) {
if( ! enabled_ECs.match(dcl.type) ) return false;
if( ! ec_cmp(ec, dcl.type) ) return false;
-
- if( getenv("match_declarative") ) {
- warnx("__gg__match_exception:%d: matched "
- "%s against mask %s for section #%zu",
- __LINE__,
- local_ec_type_str(ec), local_ec_type_str(dcl.type),
- dcl.section);
- }
return true;
} );
if( p == eodcls ) {
default_exception_handler(ec);
}
} else { // not enabled
- if( getenv("match_declarative") ) {
- warnx("__gg__match_exception:%d: raised exception "
- "%s is disabled (%zu enabled)", __LINE__,
- local_ec_type_str(ec), enabled_ECs.nec);
- }
}
}
void
__gg__set_exception_file(cblc_file_t *file)
{
- if( getenv("match_declarative") )
- {
- warnx("%s: %s", __func__, file->name);
- }
recent_file = file;
ec_type_t ec = local_ec_type_of( file->io_status );
if( ec )
void
__gg__set_exception_code(ec_type_t ec, int from_raise_statement)
{
- if( getenv("match_declarative") )
- {
- warnx("%s: raised %02x", __func__, ec);
- }
sv_from_raise_statement = from_raise_statement;
__gg__exception_code = ec;
}
if( !retval )
{
- const char *COBPATH = getenv("COBPATH");
+ const char *COBPATH = getenv("GCOBOL_LIBRARY_PATH");
retval = find_in_dirs(COBPATH, unmangled_name, mangled_name);
}
if( !retval )
projects / thirdparty / gcc.git / commitdiff
