From: Robert Dubner <[email protected]>
Date: Wed, 23 Sep 2026 11:27:31 -0400
Subject: [PATCH] cobol: Update dynamic linking search paths.
These changes modify the policies used to search for .so files when
accessing dynamically-linked programs.
gcc/cobol/ChangeLog:
* gcobol.1: Document the changes.
* genapi.cc (function_pointer_from_name): Honor the
>>CALL-CONVENTION.
(parser_set_pointers): Repair the ZEROES bug.
libgcobol/ChangeLog:
* libgcobol.cc (do_the_dl_thing): Implement the updated policies.
(find_in_dirs): Use modified do_the_dl_thing().
(__gg__function_handle_from_cobpath): Honor the call_convention.
(function_handle_from_cobpath): Likewise.
(__gg__function_handle_from_literal): Likewise.
(__gg__function_handle_from_name): Likewise.
---
gcc/cobol/gcobol.1 | 25 +--
gcc/cobol/genapi.cc | 31 +++-
libgcobol/libgcobol.cc | 359 +++++++++++++++++++++++++++++++----------
3 files changed, 311 insertions(+), 104 deletions(-)
diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1
index cdcb7146810..81dd64e76cf 100644
--- a/gcc/cobol/gcobol.1
+++ b/gcc/cobol/gcobol.1
@@ -1954,8 +1954,8 @@ precisely match the behavior of other \*[lang]
compilers.
You have been warned.
.
.Sh ENVIRONMENT
-.Bl -tag -width GCOBOL_LIBRARY_PATH
-.It Ev GCOBOL_LIBRARY_PATH
+.Bl -tag -width COBPATH
+.It Ev COBPATH
If defined, specifies the directory paths to be used by the
.Nm
runtime library,
@@ -1965,11 +1965,11 @@ Like
.Ev LD_LIBRARY_PATH ,
it may contain several directory names separated by a colon
.Pq Ql \&: .
-.Ev GCOBOL_LIBRARY_PATH
+.Ev COBPATH
is searched first, followed by
.Ev LD_LIBRARY_PATH .
Note that
-.Ev GCOBOL_LIBRARY_PATH does not change where the runtime linker looks
for
+.Ev COBPATH does not change where the runtime linker looks for
.Pa libgcobol.so
itself.
How the runtime linker searches for
@@ -1978,18 +1978,21 @@ when the executable loads is controlled by
.Xr ld.so 8 ,
not libgcobol.
.Pp
-Each directory is searched for a file whose name is based on the desired
-symbol. The literal name, with
-.Ql ".so"
-appended, is tried first. For each such file,
+Each directory is searched for files whose names are based on the desired
+symbol. As an example, consider a CALL to the program-id "FooBar". When
the
+.Sy CALL-CONVENTION COBOL
+is operative, the symbol is forced to lowercase and an attempt is made to
find
+"FOOBAR.so", followed by an attempt to find "foobar.so". When
+.Sy CALL-CONVENTION VERBATIM
+is operative, attempts are made to find "FOOBAR.so", then "FooBar.so, and
finally
+"foobar.so". For each such file,
.Xr dlopen 3
is attempted, and if successful,
.Xr dlsym 3 is used to search for the
-symbol. If either fails, a second attempt is made after converting
-the desired symbol to lowercase.
+symbol.
.Pp
When
-.Ev GCOBOL_LIBRARY_PATH and
+.Ev COBPATH and
.Ev LD_LIBRARY_PATH are not explicitly used,
binaries produced by
.Nm
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index e3753fd7709..301fd6f82e2 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -806,6 +806,8 @@ function_pointer_from_name(const cbl_refer_t &name,
NULL);
tree function_pointer_type = build_pointer_type(function_type);
+ cbl_call_convention_t call_convention = current_call_convention();
+
if( name.field->type == FldPointer )
{
tree location;
@@ -857,6 +859,7 @@ function_pointer_from_name(const cbl_refer_t &name,
INT,
current_function->our_symbol_table_index),
gg_string_literal(name.field->data.original()),
+ build_int_cst_type(INT, call_convention),
NULL_TREE));
}
else
@@ -872,6 +875,7 @@ function_pointer_from_name(const cbl_refer_t &name,
gg_get_address_of(name.field->var_decl_node),
refer_offset(name),
refer_size_source(name),
+ build_int_cst_type(INT, call_convention),
NULL_TREE));
}
@@ -13601,12 +13605,27 @@ parser_set_pointers( size_t ntgt, cbl_refer_t
*tgts, cbl_refer_t source )
&& (source.field->type == FldAlphanumeric
|| source.field->type == FldLiteralA))
{
- // This is something like SET varp TO ENTRY "ref".
- tree function_pointer = function_pointer_from_name(source,
-
COBOL_FUNCTION_RETURN_64);
- gg_memcpy(qualified_data_location(tgts[i]),
- gg_get_address_of(function_pointer),
- sizeof_pointer);
+ if( strcmp(source.field->name, "ZEROES") == 0 )
+ {
+ // This is an extra-special corner case. No, it's worse than a
corner
+ // case. It's a pointy case. The caller is essentially setting
the
+ // pointer to the figurative constant ZEROES. But ZERO is both
an
+ // alphanumeric and a numeric, depending on context. Fine. It's
+ // weird. Let's just set the destination to zeroes, and be done
with
+ // it.
+ gg_memset(qualified_data_location(tgts[i]),
+ integer_zero_node,
+ sizeof_pointer);
+ }
+ else
+ {
+ // This is something like SET varp TO ENTRY "ref".
+ tree function_pointer = function_pointer_from_name(source,
+
COBOL_FUNCTION_RETURN_64);
+ gg_memcpy(qualified_data_location(tgts[i]),
+ gg_get_address_of(function_pointer),
+ sizeof_pointer);
+ }
}
else
{
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 4332d7ddee0..9890c7dda88 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -10901,70 +10901,39 @@ __gg__set_program_list( int program_id,
static std::unordered_map<std::string, void *> already_found;
static void *
do_the_dl_thing(const char *directory,
- const char *unmangled_name,
- const char *mangled_name)
+ const std::string &file,
+ const std::string &name)
{
- // Using the GnuCOBOL convention, this code looks first for a file
- // named unmangled_name.so. It checks for a function unmangled_name
- // in that file. When not found, it checks for mangled_name.
void *retval = NULL;
- void *handle;
- std::string file;
+ std::string path;
if( directory )
{
- file = directory;
- file += '/';
+ path = directory;
+ path += '/';
}
- file += unmangled_name;
- file += ".so";
- handle = dlopen(file.c_str(), RTLD_LAZY|RTLD_NODELETE );
+ path += file;
+ void * handle = dlopen(path.c_str(), RTLD_NOW|RTLD_NODELETE );
if( handle )
{
- retval = dlsym(handle, unmangled_name);
- if( retval )
- {
- already_found[unmangled_name] = retval;
- }
- }
- if( !retval )
- {
- file.clear();
- if( directory )
- {
- file = directory;
- file += '/';
- }
- file += mangled_name;
- file += ".so";
- handle = dlopen(file.c_str(), RTLD_LAZY|RTLD_NODELETE );
- if( handle )
- {
- retval = dlsym(handle, mangled_name);
- if( retval )
- {
- already_found[mangled_name] = retval;
- }
- }
+ retval = dlsym(handle, name.c_str());
+ dlclose(handle);
}
return retval;
}
static
void *
-find_in_dirs(const char *dirs, char *unmangled_name, char *mangled_name)
- {
- std::unordered_map<std::string, void *>::const_iterator it =
- already_found.find(unmangled_name);
-
- if( it != already_found.end() )
- {
- return it->second;
- }
- it = already_found.find(mangled_name);
- if( it != already_found.end() )
- {
- return it->second;
- }
+find_in_dirs( const char *dirs,
+ const std::string &fileUPPER,
+ const std::string &fileMiddle,
+ const std::string &filelower,
+ const std::string &unmangled_name,
+ const std::string &mangled_name)
+ {
+ // We know fileUPPER and unmangled_name are not empty.
+ // The others might be empty.
+ assert( !fileUPPER.empty() );
+ assert( !unmangled_name.empty() );
void *retval = NULL;
if( dirs )
@@ -10982,62 +10951,272 @@ find_in_dirs(const char *dirs, char
*unmangled_name, char *mangled_name)
{
p += 1;
}
- // directory is the next one for us to check:
- DIR *dir = opendir(directory.c_str());
- if( dir )
+ if( directory.empty() )
+ {
+ break;
+ }
+
+ retval = do_the_dl_thing(directory.c_str(),
+ fileUPPER,
+ unmangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ if( !mangled_name.empty() )
{
retval = do_the_dl_thing(directory.c_str(),
- unmangled_name,
+ fileUPPER,
mangled_name);
- closedir(dir);
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
+
+ if( !fileMiddle.empty() )
+ {
+ retval = do_the_dl_thing(directory.c_str(),
+ fileMiddle,
+ unmangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ if( !mangled_name.empty() )
+ {
+ retval = do_the_dl_thing(directory.c_str(),
+ fileMiddle,
+ mangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
+ }
+ if( !filelower.empty() )
+ {
+ retval = do_the_dl_thing(directory.c_str(),
+ filelower,
+ unmangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ if( !mangled_name.empty() )
+ {
+ retval = do_the_dl_thing(directory.c_str(),
+ filelower,
+ mangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
}
}
}
else
{
retval = do_the_dl_thing(nullptr,
- unmangled_name,
- mangled_name);
+ fileUPPER,
+ unmangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ if( !mangled_name.empty() )
+ {
+ retval = do_the_dl_thing(nullptr,
+ fileUPPER,
+ mangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
+ if( !fileMiddle.empty() )
+ {
+ retval = do_the_dl_thing(nullptr,
+ fileMiddle,
+ unmangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ if( !mangled_name.empty() )
+ {
+ retval = do_the_dl_thing(nullptr,
+ fileMiddle,
+ mangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
+ }
+ if( !filelower.empty() )
+ {
+ retval = do_the_dl_thing(nullptr,
+ filelower,
+ unmangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ if( !mangled_name.empty() )
+ {
+ retval = do_the_dl_thing(nullptr,
+ filelower,
+ mangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
+ }
}
+ bugout:
return retval;
}
-extern "C"
-void *
-__gg__function_handle_from_cobpath( char *unmangled_name, char
*mangled_name)
+static void *
+function_handle_from_cobpath( const char *unmangled_name_,
+ const char *mangled_name_,
+ int call_convention)
{
- void *retval;
+ void *retval = NULL;
- // We search for a function. We check first for the unmangled name,
and then
- // the mangled name. We do this first for the executable, then for .so
- // files in GCOBOL_LIBRARY_PATH, and then we allow dlopen to use its
default
- // behavior.
+ /* We attempt to look up a function FooBar.
+ We first look for FooBar in the function.
+ We then look for foobar in the function.
+ We then scan the directories in COBPATH. In each directory, we look
for
+ the function name in
+ FOOBAR.so
+ FooBar.so
+ foobar.so
+ We then allow dlopen to use its defaults to find
+ FooBar
+ foobar
+ We then return NULL, indicating failure. */
- static void *handle_executable = NULL;
- if( !handle_executable )
- {
- handle_executable = dlopen(NULL, RTLD_NOW);
- }
- retval = dlsym(handle_executable, unmangled_name);
- if( !retval )
+ std::string unmangled_name = unmangled_name_;
+ std::string mangled_name = mangled_name_;
+
+ if( call_convention == 'N' )
{
- retval = dlsym(handle_executable, mangled_name);
+ // This is Native COBOL
+ // Use the mangled, lowercase name.
+ unmangled_name = mangled_name;
+ mangled_name.clear();
}
- if( !retval )
+ else
{
- const char *COBPATH = getenv("GCOBOL_LIBRARY_PATH");
- retval = find_in_dirs(COBPATH, unmangled_name, mangled_name);
+ // This is Verbatim, C-style.
+ mangled_name.clear();
}
- if( !retval )
+
+ std::string fileUPPER;
+ std::string fileMiddle;
+ std::string filelower;
+ const char *COBPATH;
+
+ static std::unordered_map<std::string, void *> already_searched;
+ std::unordered_map<std::string, void *>::const_iterator it =
+ already_searched.find(unmangled_name);
+ if( it != already_searched.end() )
{
- const char *COBPATH = getenv("LD_LIBRARY_PATH");
- retval = find_in_dirs(COBPATH, unmangled_name, mangled_name);
+ // We've already searched for this one, so return the result from the
+ // original attempt.
+ retval = it->second;
}
- if( !retval )
+ else
{
- retval = find_in_dirs(nullptr, unmangled_name, mangled_name);
- }
+ // Look for unmangled in the executable
+ static void *handle_executable = NULL;
+ if( !handle_executable )
+ {
+ handle_executable = dlopen(NULL, RTLD_NOW);
+ }
+
+ retval = dlsym(handle_executable, unmangled_name.c_str());
+ if( retval )
+ {
+ goto bugout;
+ }
+
+ // Look for mangled_name in the executable, provided it is not the
same as
+ // unmangled name:
+ if( mangled_name == unmangled_name )
+ {
+ mangled_name.clear();
+ }
+ else
+ {
+ retval = dlsym(handle_executable, mangled_name.c_str());
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
+
+ // We are going to be looking for a .so file with our entry point in
it.
+ // Build up the three filename roots:
+ fileUPPER.clear();
+ for(size_t i=0; i<unmangled_name.size(); i++)
+ {
+ char ch = unmangled_name[i];
+ fileUPPER += (ch >= 'a' && ch <= 'z') ? ch - 'a' + 'A' : ch;
+ }
+ fileUPPER += ".so";
+
+ fileMiddle = unmangled_name;
+ fileMiddle += ".so";
+ filelower.clear();
+ for(size_t i=0; i<unmangled_name.size(); i++)
+ {
+ char ch = unmangled_name[i];
+ filelower += (ch >= 'A' && ch <= 'Z') ? ch - 'A' + 'a' : ch;
+ }
+ filelower += ".so";
+
+ // Do some extra work here to avoid extra work later.
+ if( fileMiddle == fileUPPER )
+ {
+ fileMiddle.clear();
+ }
+ if( filelower == fileMiddle )
+ {
+ filelower.clear();
+ }
+
+ // We need to search through the COBPATH directories:
+
+ COBPATH = getenv("COBPATH");
+ if( COBPATH )
+ {
+
+ retval = find_in_dirs(COBPATH,
+ fileUPPER,
+ fileMiddle,
+ filelower,
+ unmangled_name,
+ mangled_name);
+ if( retval )
+ {
+ goto bugout;
+ }
+ }
+ retval = find_in_dirs(nullptr,
+ fileUPPER,
+ fileMiddle,
+ filelower,
+ unmangled_name,
+ mangled_name);
+ bugout:
+ already_searched[unmangled_name] = retval;
+ }
return retval;
}
@@ -11106,7 +11285,8 @@ __gg__just_mangle_name( const cblc_field_t
*field,
extern "C"
void *
__gg__function_handle_from_literal(int program_id,
- const char *literal)
+ const char *literal,
+ int call_convention )
{
void *retval = NULL;
static char ach_unmangled[1024];
@@ -11138,7 +11318,9 @@ __gg__function_handle_from_literal(int
program_id,
}
else
{
- retval = __gg__function_handle_from_cobpath(ach_unmangled,
ach_mangled);
+ retval = function_handle_from_cobpath(ach_unmangled,
+ ach_mangled,
+ call_convention);
}
return retval;
@@ -11149,7 +11331,8 @@ void *
__gg__function_handle_from_name(int program_id,
const cblc_field_t *field,
size_t offset,
- size_t length )
+ size_t length,
+ int call_convention )
{
void *retval = NULL;
static char ach_name[1024];
@@ -11198,7 +11381,9 @@ __gg__function_handle_from_name(int
program_id,
}
else
{
- retval = __gg__function_handle_from_cobpath(ach_unmangled,
ach_mangled);
+ retval = function_handle_from_cobpath(ach_unmangled,
+ ach_mangled,
+ call_convention);
}
return retval;
--
2.34.1
