aboutsummaryrefslogtreecommitdiff
path: root/gcc/cobol/except.cc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/cobol/except.cc')
-rw-r--r--gcc/cobol/except.cc137
1 files changed, 36 insertions, 101 deletions
diff --git a/gcc/cobol/except.cc b/gcc/cobol/except.cc
index 2118233..60b8416 100644
--- a/gcc/cobol/except.cc
+++ b/gcc/cobol/except.cc
@@ -51,7 +51,7 @@ static const ec_descr_t *
ec_type_descr( ec_type_t type ) {
auto p = std::find( __gg__exception_table, __gg__exception_table_end, type );
if( p == __gg__exception_table_end ) {
- cbl_internal_error("no such exception: 0x%04x", type);
+ cbl_internal_error("no such exception: 0x%x", type);
}
return p;
}
@@ -77,11 +77,11 @@ ec_level( ec_type_t ec ) {
void
cbl_enabled_exception_t::dump( int i ) const {
- cbl_message(2, "cbl_enabled_exception_t: %2d {%s, %s, %s, %zu}",
- i,
- location? "location" : " none",
- ec_type_str(ec),
- file );
+ cbl_message(2, "cbl_enabled_exception_t: %2d {%s, %s, %zu}",
+ i,
+ location? "location" : " none",
+ ec_type_str(ec),
+ file );
}
cbl_enabled_exceptions_t enabled_exceptions;
@@ -99,23 +99,25 @@ cbl_enabled_exceptions_t::dump() const {
}
int i = 1;
for( auto& elem : *this ) {
- dbgmsg("cbl_enabled_exceptions_t: %2d {%s, %s, %zu}",
+ dbgmsg("cbl_enabled_exceptions_t: %2d {%s, %s, %lu}",
i++,
elem.location? "with location" : " no location",
ec_type_str(elem.ec),
- elem.file );
+ gb4(elem.file) );
}
std::swap(debug, yydebug);
}
+// cppcheck-suppress-begin [useStlAlgorithm] because why?
uint32_t
cbl_enabled_exceptions_t::status() const {
uint32_t status_word = 0;
for( const auto& ena : *this ) {
status_word |= (EC_ALL_E & ena.ec );
- }
+ }
return status_word;
}
+// cppcheck-suppress-end useStlAlgorithm
std::vector<uint64_t>
cbl_enabled_exceptions_t::encode() const {
@@ -133,13 +135,13 @@ void
cbl_enabled_exceptions_t::turn_on_off( bool enabled,
bool location,
ec_type_t type,
- std::set<size_t> files )
+ const std::set<size_t>& files )
{
// Update current enabled ECs tree on leaving this function.
class update_parser_t {
const cbl_enabled_exceptions_t& ecs;
public:
- update_parser_t(const cbl_enabled_exceptions_t& ecs) : ecs(ecs) {}
+ explicit update_parser_t(const cbl_enabled_exceptions_t& ecs) : ecs(ecs) {}
~update_parser_t() {
tree ena = parser_compile_ecs(ecs.encode());
current_enabled_ecs(ena);
@@ -244,16 +246,6 @@ cbl_enabled_exceptions_t::match( ec_type_t type, size_t file ) const {
return output != end()? &*output : NULL;
}
-class choose_declarative {
- size_t program;
- public:
- choose_declarative( size_t program ) : program(program) {}
-
- bool operator()( const cbl_declarative_t& dcl ) {
- return dcl.global || program == symbol_at(dcl.section)->program;
- }
-};
-
bool
sort_supers_last( const cbl_declarative_t& a, const cbl_declarative_t& b ) {
if( symbol_at(a.section)->program == symbol_at(b.section)->program ) {
@@ -263,66 +255,6 @@ sort_supers_last( const cbl_declarative_t& a, const cbl_declarative_t& b ) {
}
cbl_field_t * new_temporary_decl();
-
-/*
- * For a program, create a "DECLARATIVES" entry in the symbol table,
- * representing eligible declarative sections in priorty order:
- * in-program first, followed by any global declaratives in parent
- * programs. These decribe the USE criteria declared for each
- * declarative section.
- *
- * The field's initial value is actually an array of
- * cbl_declarartive_t, in which the first element is unused, except
- * that array[0].section represents the number of elements, starting
- * at array[1].
- *
- * The returned value is the declarative's symbol index. It is passed
- * to match_exception, which scans it for a declarative whose criteria
- * match the raised exception. That function returns the
- * cbl_declarative_t::section, which the program then uses to PERFORM
- * that section.
- */
-size_t
-symbol_declaratives_add( size_t program,
- const std::list<cbl_declarative_t>& dcls )
-{
- auto n = dcls.size();
- if( n == 0 ) return 0;
-
- auto blob = new cbl_declarative_t[ 1 + n ];
-
- auto pend = std::copy_if( dcls.begin(), dcls.end(), blob + 1,
- choose_declarative(program) );
-
- std::sort( blob + 1, pend, sort_supers_last );
-
- // Overload blob[0].section to be the count.
- blob[0].section = (pend - blob) - 1;
-
- size_t len = reinterpret_cast<char*>(pend)
- - reinterpret_cast<char*>(blob);
- assert(len == (blob[0].section + 1) * sizeof(blob[0]));
-
- // Construct a "blob" in the symbol table.
- static int blob_count = 1;
- char achBlob[32];
- sprintf(achBlob, "_DECLARATIVE_BLOB%d_", blob_count++);
-
- cbl_field_data_t data = {};
- data.memsize = capacity_cast(len);
- data.capacity = capacity_cast(len);
- data.initial = reinterpret_cast<char*>(blob);
- data.picture = reinterpret_cast<char*>(blob);
- cbl_field_t field = { 0, FldBlob, FldInvalid, constant_e,
- 0, 0, 0, cbl_occurs_t(), 0, "",
- 0, {}, data, NULL };
- strcpy(field.name, achBlob);
-
- auto e = symbol_field_add(program, &field);
- parser_symbol_add(cbl_field_of(e));
- return symbol_index(e);
-}
-
/*
* Generate the code to evaluate declaratives. This is the "secret
* section" right after END DECLARATIVES. Its name is
@@ -345,37 +277,42 @@ size_t current_file_index();
file_status_t current_file_handled_status();
void
-declarative_runtime_match( cbl_field_t *declaratives, cbl_label_t *lave ) {
+declarative_runtime_match( const std::list<cbl_declarative_t>& declaratives,
+ cbl_label_t *lave )
+{
if( getenv("GCOBOL_SHOW") )
{
fprintf(stderr, "( %d ) %s: \n", cobol_location().first_line, __func__);
}
if( getenv("GCOBOL_TRACE") )
{
- gg_printf(">>>>>>( %d )(%s) declaratives:%s lave:%s\n",
+ gg_printf(">>>>>>( %d )(%s) declaratives: lave:%s\n",
build_int_cst_type(INT, cobol_location().first_line),
gg_string_literal(__func__),
- gg_string_literal(declaratives->name),
gg_string_literal(lave->name),
NULL_TREE);
}
static auto yes = new_temporary(FldConditional);
- static auto psection = new_temporary(FldNumericBin5);
+ static auto isection = new_temporary(FldNumericBin5);
+ static auto index = new_temporary(FldNumericBin5);
+ /*
+ * Generate a sequence of COBOL IF statements to match the Declarative's
+ * symbol table index to its performable section. The entire sequence is
+ * guarded by a runtime IF that evaluates to TRUE only if the "current EC" is
+ * nonzero. This way, when _DECLARATIVES_EVAL is performed, it does nothing
+ * if no EC was raised.
+ */
IF( var_decl_exception_code, ne_op, integer_zero_node ) {
- // Send blob, get declarative section index.
- auto index = new_temporary(FldNumericBin5);
+ // Get declarative section index matching any raised EC.
parser_match_exception(index);
- auto p = declaratives->data.initial;
- const auto dcls = reinterpret_cast<const cbl_declarative_t *>(p);
- size_t ndcl = dcls[0].section; // overloaded
// Compare returned index to each section index.
- for( auto p = dcls + 1; p < dcls + 1 + ndcl; p++ ) {
- parser_set_numeric( psection, p->section );
- parser_relop( yes, index, eq_op, psection );
+ for( const auto& dcl : declaratives ) {
+ parser_set_numeric( isection, dcl.section );
+ parser_relop( yes, index, eq_op, isection );
parser_if( yes );
- auto section = cbl_label_of(symbol_at(p->section));
+ auto section = cbl_label_of(symbol_at(dcl.section));
parser_push_exception();
parser_perform(section);
parser_pop_exception();
@@ -385,17 +322,15 @@ declarative_runtime_match( cbl_field_t *declaratives, cbl_label_t *lave ) {
}
}
ELSE {
- if( getenv("TRACE1") )
+ if( getenv("GCOBOL_TRACE") )
{
- gg_printf(">>>>>>( %d )(%s) __gg__exception_code is zero\n",
- build_int_cst_type(INT, cobol_location().first_line),
- gg_string_literal(__func__),
- NULL_TREE);
+ gg_printf(">>>>>>( %d )(%s) __gg__exception_code is zero\n",
+ build_int_cst_type(INT, cobol_location().first_line),
+ gg_string_literal(__func__),
+ NULL_TREE);
}
}
ENDIF
-
- parser_label_label(lave);
}
ec_type_t
generated by cgit v1.1 at 2025-07-02 00:29:11 +0000