From: Robert Dubner <[email protected]>
Date: Tue, 29 Sep 2026 22:20:20 -0400
Subject: [PATCH] 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.
---
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 c0f2b448964..5c14b9b9865 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 479e0e5ba35..bfbe022c7e1 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 685fee28705..088be4233ca 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 c0924a81a2e..ca3adf82bc6 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)
--
2.34.1
