https://gcc.gnu.org/g:36da5957271c9fec602e87099149a2c1572df360
commit r17-4770-g36da5957271c9fec602e87099149a2c1572df360 Author: Robert Dubner <[email protected]> Date: Tue Sep 29 22:20:20 2026 -0400 cobol: Decrease middle-end processing time with better GENERIC. Diving into the GIMPLE dumps revealed a lot of time was spent processing COBOL variable initialization. One set of these changes collect variable initialization into table-driven calls to the library. Another set combines GENERIC nodes into batches that are processed as groups. The results reduce middle-end time by factors of three to five, although it remains highly dependent on the source code being processed. Assisted by ChatGPT 6 Astra gcc/cobol/ChangeLog: * genapi.cc (propogate_linkage_offsets): Spelling fixed. (collect_linkage_offsets): Use tables of offsets into COBOL hierarchical variables. (propagate_linkage_offsets): Likewise. (establish_using): Use corrected spelling. (parser_set_pointers): Likewise. * gengen.cc (struct gg_init_batch_stats): Batch adjacent clean initializations without moving them across executable statements. (gg_init_batch_candidate): Likewise. (gg_init_batch_static_decl): Likewise. (gg_init_batch_call): Likewise. (gg_batch_initializations): Likewise. (gg_finalize_function): Likewise. * move.cc (mh_alpha_to_alpha): Use runtime memset() instead of using build_string_literal on strings of spaces. libgcobol/ChangeLog: * libgcobol.cc (__gg__propagate_linkage_offsets): New routine for applying the tables of offsets. Diff: --- gcc/cobol/genapi.cc | 130 ++++++++++++++++++------ gcc/cobol/gengen.cc | 261 +++++++++++++++++++++++++++++++++++++++++++++++++ gcc/cobol/move.cc | 159 +++++++++++++++++++----------- libgcobol/libgcobol.cc | 22 +++++ 4 files changed, 486 insertions(+), 86 deletions(-) diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index c0f2b448964d..5c14b9b98657 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -6323,60 +6323,134 @@ parser_arith_error_end(cbl_label_t *arithmetic_label) gg_append_statement( arithmetic_label->structs.arith_error->over.label ); } +// Preserve the existing traversal, including repeated entries from REDEFINES. static void -propogate_linkage_offsets(cbl_field_t *field, tree base) +collect_linkage_offsets(cbl_field_t *field, + tree base, + std::vector<cbl_field_t *> &fields) { if( field->level == LEVEL01 || field->level == LEVEL77 ) { field->data_decl_node = base; - symbol_elem_t *e = symbol_at(field_index(field)); - // We already updated the data pointer of the first element: - e += 1; + symbol_elem_t *e = symbol_at(field_index(field)) + 1; while( e < symbols_end() ) { - symbol_elem_t& element = *e++; + symbol_elem_t &element = *e++; if( element.type == SymField ) { cbl_field_t *this_one = cbl_field_of(&element); if( this_one->level == LEVEL01 || this_one->level == LEVEL77 ) { - // We have encountered another level 01/77. If this LEVEL 01 had a - // parent, then we have to assume that this is a redefines of another - // level 01/77. if( this_one->parent ) { - // And, gloriously and frighteningly, it can be handled by - // recursion: - propogate_linkage_offsets(this_one, base); + collect_linkage_offsets(this_one, base, fields); } else { - // Having encountered the next 01 or 77, we are done break; } } if( this_one->level == 00 ) { - // Ignore LEVEL00 "INDEXED BY" variables continue; } - tree offset = gg_define_variable(SIZE_T); - IF( base, eq_op, gg_cast(UCHAR_P, null_pointer_node) ) - { - gg_assign(offset, size_t_zero_node); - } - ELSE - { - gg_assign(offset, member(this_one, "offset")); - } - ENDIF this_one->data_decl_node = base; - member( this_one, - "data", - gg_add(base, offset)); + fields.push_back(this_one); + } + } + } + } + +static void +propagate_linkage_offsets(cbl_field_t *field, tree base) + { + std::vector<cbl_field_t *> fields; + collect_linkage_offsets(field, base, fields); + if( fields.empty() ) + { + return; + } + + // Both current callers supply an addressable pointer: a local variable + // for USING, or a descriptor's data member for SET ADDRESS OF. + // Retain the old emission for other expressions or nonstatic descriptors. + bool batchable = TREE_TYPE(base) == UCHAR_P + && !TREE_THIS_VOLATILE(base) + && (TREE_CODE(base) == VAR_DECL + || TREE_CODE(base) == PARM_DECL + || TREE_CODE(base) == COMPONENT_REF); + for( size_t i = 0; i < fields.size(); ++i ) + { + tree decl = fields[i]->var_decl_node; + if( !decl + || TREE_CODE(decl) != VAR_DECL + || !TREE_STATIC(decl) + || DECL_EXTERNAL(decl) + || DECL_WEAK(decl) + || DECL_THREAD_LOCAL_P(decl) + || DECL_HAS_VALUE_EXPR_P(decl) + || TREE_THIS_VOLATILE(decl) ) + { + batchable = false; + break; + } + } + + if( !batchable ) + { + for( size_t i = 0; i < fields.size(); ++i ) + { + cbl_field_t *this_one = fields[i]; + tree offset = gg_define_variable(SIZE_T); + IF( base, eq_op, gg_cast(UCHAR_P, null_pointer_node) ) + { + gg_assign(offset, size_t_zero_node); + } + ELSE + { + gg_assign(offset, member(this_one, "offset")); } + ENDIF + member(this_one, "data", gg_add(base, offset)); } + return; } + + static size_t table_number = 0; + char name[96]; + snprintf(name, sizeof(name), + "..linkage_offsets_" HOST_SIZE_T_PRINT_DEC, + (fmt_size_t)table_number++); + + tree array_type = build_array_type_nelts(VOID_P, fields.size()); + vec<constructor_elt, va_gc> *elts = NULL; + for( size_t i = 0; i < fields.size(); ++i ) + { + CONSTRUCTOR_APPEND_ELT( + elts, + build_int_cst_type(SIZE_T, i), + gg_cast(VOID_P, gg_get_address_of(fields[i]->var_decl_node))); + } + tree initializer = build_constructor(array_type, elts); + gcc_assert(TREE_CONSTANT(initializer)); + TREE_STATIC(initializer) = 1; + + tree table = gg_declare_variable(array_type, name, NULL_TREE, + vs_file_static); + DECL_INITIAL(table) = initializer; + TREE_READONLY(table) = 1; + DECL_ARTIFICIAL(table) = 1; + DECL_IGNORED_P(table) = 1; + gg_define_from_declaration(table); + + // Pass the location of the base, not a snapshot of its value. This + // preserves repeated reads if a preceding descriptor store changes it. + gg_call(VOID, + "__gg__propagate_linkage_offsets", + gg_pointer_to_array(table), + gg_get_address_of(base), + build_int_cst_type(SIZE_T, fields.size()), + NULL_TREE); } static bool initialized_data = false; @@ -6663,7 +6737,7 @@ establish_using(size_t nusing, // We need to apply reference + offset to the LINKAGE variable // and all of its children - propogate_linkage_offsets( args[i].field(), reference ); + propagate_linkage_offsets( args[i].field(), reference ); } if( crv == by_value_e ) @@ -13790,7 +13864,7 @@ parser_set_pointers( size_t ntgt, cbl_refer_t *tgts, cbl_refer_t source ) // When SET ADDRESS OF TARGET TO ..., the library call sets // tgts[i].field->data. We need to propagate the data+offset // through the level01 variable's children: - propogate_linkage_offsets(tgts[i].field, + propagate_linkage_offsets(tgts[i].field, member(tgts[i].field->var_decl_node, "data")); } } diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc index 479e0e5ba35e..bfbe022c7e10 100644 --- a/gcc/cobol/gengen.cc +++ b/gcc/cobol/gengen.cc @@ -2875,6 +2875,251 @@ gg_modify_function_type(tree function_decl, tree return_type) DECL_RESULT (function_decl) = resdecl; } +/* Batch adjacent clean initializations without moving them across executable + statements. This runs on completed GENERIC, not on the emission stacks. */ +struct gg_init_batch_stats + { + unsigned long eligible = 0; + unsigned long batches = 0; + unsigned long eliminated = 0; + }; + +static bool +gg_init_batch_candidate(tree stmt, tree &field, tree &flags) + { + if( TREE_CODE(stmt) != CALL_EXPR || call_expr_nargs(stmt) != 2 ) + { + return false; + } + + tree callee = CALL_EXPR_FN(stmt); + STRIP_NOPS(callee); + if( TREE_CODE(callee) != ADDR_EXPR ) + { + return false; + } + callee = TREE_OPERAND(callee, 0); + if( TREE_CODE(callee) != FUNCTION_DECL + || !DECL_NAME(callee) + || strcmp(IDENTIFIER_POINTER(DECL_NAME(callee)), + "__gg__initialize_variable_clean") != 0 ) + { + return false; + } + + flags = CALL_EXPR_ARG(stmt, 1); + if( TREE_CODE(flags) != INTEGER_CST ) + { + return false; + } + + tree address = CALL_EXPR_ARG(stmt, 0); + STRIP_NOPS(address); + if( TREE_CODE(address) != ADDR_EXPR ) + { + return false; + } + field = TREE_OPERAND(address, 0); + if( TREE_CODE(field) != VAR_DECL + || !TREE_STATIC(field) + || DECL_EXTERNAL(field) + || DECL_WEAK(field) + || DECL_THREAD_LOCAL_P(field) + || DECL_HAS_VALUE_EXPR_P(field) ) + { + return false; + } + return true; + } + +static bool +gg_init_batch_static_decl(tree stmt) + { + if( TREE_CODE(stmt) != DECL_EXPR ) + { + return false; + } + tree decl = DECL_EXPR_DECL(stmt); + if( TREE_CODE(decl) != VAR_DECL + || !TREE_STATIC(decl) + || DECL_EXTERNAL(decl) + || DECL_THREAD_LOCAL_P(decl) + || DECL_HAS_VALUE_EXPR_P(decl) ) + { + return false; + } + tree initial = DECL_INITIAL(decl); + return !initial + || (initial != error_mark_node + && TREE_CONSTANT(initial) + && !TREE_SIDE_EFFECTS(initial)); + } + +static tree +gg_init_batch_call(const std::vector<tree> &fields, + tree flags, location_t location) + { + static unsigned long serial = 0; + char name[80]; + snprintf(name, sizeof(name), "..initialization_batch_%lu", ++serial); + + /* Match the existing parser_init_list's array of VOID_P. Only addresses + of non-TLS static objects are accepted above, so this needs no runtime + table construction. Keep the null terminator required by the helper. */ + tree array_type = build_array_type_nelts(VOID_P, fields.size() + 1); + tree initial = make_node(CONSTRUCTOR); + TREE_TYPE(initial) = array_type; + TREE_CONSTANT(initial) = 1; + TREE_STATIC(initial) = 1; + for( size_t i = 0; i < fields.size(); ++i ) + { + tree address = build1(ADDR_EXPR, + build_pointer_type(TREE_TYPE(fields[i])), + fields[i]); + TREE_ADDRESSABLE(fields[i]) = 1; + CONSTRUCTOR_APPEND_ELT(CONSTRUCTOR_ELTS(initial), + build_int_cst_type(SIZE_T, i), + fold_convert(VOID_P, address)); + } + CONSTRUCTOR_APPEND_ELT(CONSTRUCTOR_ELTS(initial), + build_int_cst_type(SIZE_T, fields.size()), + build_int_cst(VOID_P, 0)); + + /* File scope is intentional: the function's context stacks are already + closed. Register the fully initialized declaration through the usual + file-scope machinery, which does not append a runtime statement. */ + tree table = gg_declare_variable(array_type, name, initial, vs_file_static); + TREE_READONLY(table) = 1; + TREE_ADDRESSABLE(table) = 1; + DECL_ARTIFICIAL(table) = 1; + DECL_IGNORED_P(table) = 1; + gg_define_from_declaration(table); + + tree address = build1(ADDR_EXPR, build_pointer_type(array_type), table); + tree pointer = fold_convert(build_pointer_type(VOID_P), address); + tree call = gg_call_expr(VOID, "__gg__variables_to_init", + pointer, flags, NULL_TREE); + SET_EXPR_LOCATION(call, location); + return call; + } + +static void +gg_batch_initializations(tree &node, gg_init_batch_stats &stats) + { + if( !node ) + { + return; + } + switch( TREE_CODE(node) ) + { + case STATEMENT_LIST: + { + tree result = alloc_stmt_list(); + std::vector<tree> pending; + std::vector<tree> fields; + tree run_flags = NULL_TREE; + location_t location = UNKNOWN_LOCATION; + + auto flush = [&]() + { + if( fields.size() < 2 ) + { + for( tree stmt : pending ) + { + append_to_statement_list_force(stmt, &result); + } + } + else + { + /* Retain static declarations in their original order. They have + no runtime effects; emit the batch after these declarations. */ + for( tree stmt : pending ) + { + if( TREE_CODE(stmt) == DECL_EXPR ) + { + append_to_statement_list_force(stmt, &result); + } + } + append_to_statement_list_force( + gg_init_batch_call(fields, run_flags, location), &result); + ++stats.batches; + stats.eliminated += fields.size() - 1; + } + pending.clear(); + fields.clear(); + run_flags = NULL_TREE; + }; + + for( tree_stmt_iterator it = tsi_start(node); + !tsi_end_p(it); tsi_next(&it) ) + { + tree stmt = tsi_stmt(it); + tree field = NULL_TREE; + tree flags = NULL_TREE; + if( gg_init_batch_candidate(stmt, field, flags) ) + { + ++stats.eligible; + if( run_flags + && (TREE_TYPE(run_flags) != TREE_TYPE(flags) + || !tree_int_cst_equal(run_flags, flags)) ) + { + flush(); + } + if( fields.empty() ) + { + run_flags = flags; + location = EXPR_LOCATION(stmt); + } + pending.push_back(stmt); + fields.push_back(field); + } + else if( !fields.empty() && gg_init_batch_static_decl(stmt) ) + { + pending.push_back(stmt); + } + else + { + flush(); + gg_batch_initializations(stmt, stats); + append_to_statement_list_force(stmt, &result); + } + } + flush(); + node = result; + break; + } + + case BIND_EXPR: + gg_batch_initializations(BIND_EXPR_BODY(node), stats); + break; + + case COND_EXPR: + /* Never batch across the condition or between its alternatives. */ + gg_batch_initializations(TREE_OPERAND(node, 1), stats); + gg_batch_initializations(TREE_OPERAND(node, 2), stats); + break; + + case LOOP_EXPR: + gg_batch_initializations(LOOP_EXPR_BODY(node), stats); + break; + + case SWITCH_EXPR: + gg_batch_initializations(SWITCH_BODY(node), stats); + break; + + case TRY_FINALLY_EXPR: + case TRY_CATCH_EXPR: + gg_batch_initializations(TREE_OPERAND(node, 0), stats); + gg_batch_initializations(TREE_OPERAND(node, 1), stats); + break; + + default: + /* In particular, do not walk declarations, initializers, arbitrary + value expressions, or nested function declarations. */ + break; + } + } + void gg_finalize_function() { @@ -2887,6 +3132,22 @@ gg_finalize_function() // Finish off the context gg_pop_context(); + /* Work on the completed body. Do not use gg_append_statement here: + gg_pop_context has closed the emission stacks. */ + if( !getenv("GCOBOL_INIT_BATCH_DISABLE") ) + { + gg_init_batch_stats stats; + gg_batch_initializations( + DECL_SAVED_TREE(current_function->function_decl), stats); + if( getenv("GCOBOL_INIT_BATCH_REPORT") ) + { + fprintf(stderr, + "gcobol initialization batching: eligible=%lu batches=%lu " + "eliminated=%lu\n", + stats.eligible, stats.batches, stats.eliminated); + } + } + /* Because COBOL functions can be misleadingly referenced before they defined, and because our compiler is single pass, we need to defer actually passing the function_decls to the middle end until we are diff --git a/gcc/cobol/move.cc b/gcc/cobol/move.cc index 685fee287056..088be4233ca6 100644 --- a/gcc/cobol/move.cc +++ b/gcc/cobol/move.cc @@ -2359,6 +2359,10 @@ mh_alpha_to_alpha(const cbl_refer_t &destref, && !sourceref.all ) { + charmap_t *charmap =__gg__get_charmap(destref.field->codeset.encoding); + cbl_char_t space = charmap->mapped_character(ascii_space); + int stride = charmap->stride(); + void (*mover)(tree, tree, tree); // dest, source, count mover = have_common_parent(destref, sourceref) ? gg_memmove : gg_memcpy; @@ -2378,26 +2382,41 @@ mh_alpha_to_alpha(const cbl_refer_t &destref, { // This is a tad more complicated. The source is too short, so we need // to copy over what we can... - mover(member( destref.field->var_decl_node, "data"), - member(sourceref.field->var_decl_node, "data"), - build_int_cst_type(SIZE_T, sourceref.field->data.capacity())); + tree source_len = build_int_cst_type(SIZE_T, + sourceref.field->data.capacity()); + mover(member(destref.field->var_decl_node, "data"), + member(sourceref.field->var_decl_node, "data"), + source_len); + // And then space-fill the rest: - size_t fill_bytes = - destref.field->data.capacity() - sourceref.field->data.capacity(); - - // ...and then create a memory area with the fill spaces... - char *spaces = static_cast<char *>(xmalloc(fill_bytes)); - charmap_t *charmap =__gg__get_charmap(destref.field->codeset.encoding); - charmap->memset(spaces, - charmap->mapped_character(ascii_space), - fill_bytes); - // ...and then copy those spaces into place. - mover( - gg_add(member(destref.field->var_decl_node, "data"), - build_int_cst_type(SIZE_T, sourceref.field->data.capacity())), - build_string_literal(fill_bytes, spaces), - build_int_cst_type(SIZE_T, fill_bytes)); - free(spaces); + if( stride == 1 ) + { + tree dest_len = build_int_cst_type(SIZE_T, + destref.field->data.capacity()); + gg_memset(gg_add(member(destref.field->var_decl_node, "data"), + source_len), + build_int_cst_type(INT, space), + gg_subtract(dest_len, source_len)); + } + else + { + // And then space-fill the rest: + size_t fill_bytes = + destref.field->data.capacity() - sourceref.field->data.capacity(); + + // ...and then create a memory area with the fill spaces... + char *spaces = static_cast<char *>(xmalloc(fill_bytes)); + charmap->memset(spaces, + space, + fill_bytes); + // ...and then copy those spaces into place. + mover( + gg_add(member(destref.field->var_decl_node, "data"), + build_int_cst_type(SIZE_T, sourceref.field->data.capacity())), + build_string_literal(fill_bytes, spaces), + build_int_cst_type(SIZE_T, fill_bytes)); + free(spaces); + } moved = true; } } @@ -2428,19 +2447,27 @@ mh_alpha_to_alpha(const cbl_refer_t &destref, // The source data is too short. We need to copy over what we have... mover(dest_data, source_data, source_len); - // And then right-fill the remainder with spaces. Create a buffer with - // more than enough spaces for our purposes: - size_t fill_bytes = destref.field->data.capacity(); - char *spaces = static_cast<char *>(xmalloc(fill_bytes)); - charmap_t *charmap =__gg__get_charmap(destref.field->codeset.encoding); - charmap->memset(spaces, - charmap->mapped_character(ascii_space), - fill_bytes); - // And then copy enough of those spaces into place. - mover(gg_add(dest_data, source_len), - build_string_literal(fill_bytes, spaces), - gg_subtract(dest_len, source_len)); - free(spaces); + // And then right-fill the remainder with spaces. + if( stride == 1 ) + { + gg_memset(gg_add(dest_data, source_len), + build_int_cst_type(INT, space), + gg_subtract(dest_len, source_len)); + } + else + { + // Create a buffer with more than enough spaces for our purposes: + size_t fill_bytes = destref.field->data.capacity(); + char *spaces = static_cast<char *>(xmalloc(fill_bytes)); + charmap->memset(spaces, + space, + fill_bytes); + // And then copy enough of those spaces into place. + mover(gg_add(dest_data, source_len), + build_string_literal(fill_bytes, spaces), + gg_subtract(dest_len, source_len)); + free(spaces); + } } ENDIF moved = true; @@ -2470,19 +2497,27 @@ mh_alpha_to_alpha(const cbl_refer_t &destref, // The source data is too short. We need to copy over what we have... mover(dest_data, source_data, source_len); - // And then right-fill the remainder with spaces. Create a buffer with - // more than enough spaces for our purposes: - size_t fill_bytes = destref.field->data.capacity(); - char *spaces = static_cast<char *>(xmalloc(fill_bytes)); - charmap_t *charmap =__gg__get_charmap(destref.field->codeset.encoding); - charmap->memset(spaces, - charmap->mapped_character(ascii_space), - fill_bytes); - // And then copy enough of those spaces into place. - mover(gg_add(dest_data, source_len), - build_string_literal(fill_bytes, spaces), - gg_subtract(dest_len, source_len)); - free(spaces); + // And then right-fill the remainder with spaces. + if( stride == 1 ) + { + gg_memset(gg_add(dest_data, source_len), + build_int_cst_type(INT, space), + gg_subtract(dest_len, source_len)); + } + else + { + // Create a buffer with more than enough spaces for our purposes: + size_t fill_bytes = destref.field->data.capacity(); + char *spaces = static_cast<char *>(xmalloc(fill_bytes)); + charmap->memset(spaces, + space, + fill_bytes); + // And then copy enough of those spaces into place. + mover(gg_add(dest_data, source_len), + build_string_literal(fill_bytes, spaces), + gg_subtract(dest_len, source_len)); + free(spaces); + } } ENDIF @@ -2516,19 +2551,27 @@ mh_alpha_to_alpha(const cbl_refer_t &destref, // The source data is too short. We need to copy over what we have... mover(dest_data, source_data, source_len); - // And then right-fill the remainder with spaces. Create a buffer with - // more than enough spaces for our purposes: - size_t fill_bytes = destref.field->data.capacity(); - char *spaces = static_cast<char *>(xmalloc(fill_bytes)); - charmap_t *charmap =__gg__get_charmap(destref.field->codeset.encoding); - charmap->memset(spaces, - charmap->mapped_character(ascii_space), - fill_bytes); - // And then copy enough of those spaces into place. - mover(gg_add(dest_data, source_len), - build_string_literal(fill_bytes, spaces), - gg_subtract(dest_len, source_len)); - free(spaces); + // And then right-fill the remainder with spaces. + if( stride == 1 ) + { + gg_memset(gg_add(dest_data, source_len), + build_int_cst_type(INT, space), + gg_subtract(dest_len, source_len)); + } + else + { + // Create a buffer with more than enough spaces for our purposes: + size_t fill_bytes = destref.field->data.capacity(); + char *spaces = static_cast<char *>(xmalloc(fill_bytes)); + charmap->memset(spaces, + space, + fill_bytes); + // And then copy enough of those spaces into place. + mover(gg_add(dest_data, source_len), + build_string_literal(fill_bytes, spaces), + gg_subtract(dest_len, source_len)); + free(spaces); + } } ENDIF diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index c0924a81a2e7..ca3adf82bc69 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -11522,6 +11522,28 @@ __gg__function_handle_from_name(int program_id, return retval; } +extern "C" +void +__gg__propagate_linkage_offsets(void * const fields[], + unsigned char * const *base_address, + size_t count) + { + for( size_t i = 0; i < count; ++i ) + { + cblc_field_t *field = static_cast<cblc_field_t *>(fields[i]); + unsigned char *base = *base_address; + if( base ) + { + field->data = base + field->offset; + } + else + { + // Do not read offset, or perform pointer arithmetic, for a null base. + field->data = nullptr; + } + } + } + extern "C" void __gg__variables_to_init(cblc_field_t *array[], const int flag_bits)
