Merge remote-tracking branch 'upstream/gnucobol-3.x' into gitside-gnucobol-3.x

Author: ddeclerck

NEWS

@@ -133,6 +133,12 @@ NEWS - user visible changes				-*- outline -*-
    $b for executable basename, $d for date in YYYYMMDD format, $t for time
    in HHMMSS format (before, only $$ was available for pid)
 
+** Introduction of the COB_LOAD_GLOBAL boolean flag, which determines whether
+   the symbols of dynamically loaded shared libraries are made available
+   globally to other shared objects or remain confined locally. Previously,
+   this behavior depended on the underlying platform, where the default was
+   often "global." The default behavior is now explicitly set to "local".
+
 * New build features
 
 ** configure now uses pkg-config/ncurses-config to search for ncurses and

cobc/ChangeLog

@@ -1,4 +1,9 @@
 
+2025-12-29  Roger Bowler <rbowler@snipix.net>
+
+	* tree.c (finalize_file): if file is EXTFH enabled then don't warn for
+	  ORGANIZATION INDEXED, even when compiler is configured --without-db
+
 2025-12-04  Roger Bowler <rbowler@snipix.net>
 
 	* parser.y (entry): check that ENTRY statement begins in area B not area A

cobc/tree.c

@@ -5033,7 +5033,7 @@ finalize_file (struct cb_file *f, struct cb_field *records)
 #if	!defined (WITH_INDEX_EXTFH) && \
 	!defined (WITH_DB) && \
 	!defined (WITH_CISAM) && !defined(WITH_DISAM) && !defined(WITH_VBISAM)
-	if (f->organization == COB_ORG_INDEXED) {
+	if (f->organization == COB_ORG_INDEXED && !f->extfh) {
 		char msg[80];
 		snprintf (msg, sizeof (msg), "ORGANIZATION INDEXED; FD %s", f->name);
 		cb_warning_x (cb_warn_unsupported, f->description_entry,

config/ChangeLog

@@ -13,6 +13,10 @@
 
 	* gcos-strict.conf: set init-justify to no after testing on GCOS
 
+2024-12-16  Simon Sobisch <simonsobisch@gnu.org>
+
+	* config/runtime.cfg: add COB_LOAD_GLOBAL
+
 2024-08-17 Ammar Almoris <ammaralmorsi@gmail.com>
 
 	FR #474: add runtime configuration to hide cursor for extended screenio

config/runtime.cfg

@@ -323,6 +323,19 @@
 #          Default:  false
 #          Example:  PHYSICAL_CANCEL  TRUE
 
+# Environment name:  COB_LOAD_GLOBAL
+#   Parameter name:  load_global
+#          Purpose:  tell the system loader to provide symbols in CALLed
+#                    programs globally, allowing symbols to be found for linked
+#                    libraries later
+#             Type:  boolean
+#             Note:  COBOL CALLs will always find symbols in already CALLed or
+#                    pre-loaded modules; this setting is mostly an advise to the
+#                    system, not all systems are capable of loading libraries
+#                    global/local
+#          Default:  false
+#          Example:  load_global true
+
 #
 ## File I/O
 #

libcob/ChangeLog

@@ -206,6 +206,18 @@
 	* common.h, common.c: handle [__xlc__] identical to [__IBMC__]
 	* common.c [!SIGPIPE]: fix warning about unused jump
 
+2025-01-08  Florian Schmidt <florian.schmidt.1994@icloud.com>
+            Simon Sobisch <simonsobisch@gnu.org>
+
+  * call.c (cob_dlopen): new function used instead of partially re-defining
+    lt_dlopen; changed default to not load symbols to the global namespace
+    any more but locally (was always the case for _WIN32)
+  * common.c, coblocal.h (cob_settings): added boolean COB_LOAD_GLOBAL
+    to toggle into which namespace the symbols of CALLed programs should be
+    made available
+  * call.c (cob_dlopen, add_to_preload, cache_preload, cob_exit_call):
+    handle COB_LOAD_GLOBAL (load_global)
+
 2024-12-31  Simon Sobisch <simonsobisch@gnu.org>
 
 	* common.c [WITH_EXTENDED_SCREENIO]: adjusted curses includes/defines

libcob/call.c

@@ -66,15 +66,6 @@ FILE *fmemopen (void *buf, size_t size, const char *mode);
 #include <windows.h>
 #include <io.h>	/* for access */
 
-static HMODULE
-lt_dlopen (const char *x)
-{
-	if (x == NULL) {
-		return GetModuleHandle (NULL);
-	}
-	return LoadLibrary(x);
-}
-
 static void *
 lt_dlsym (HMODULE hmod, const char *p)
 {
@@ -106,7 +97,6 @@ lt_dlerror (void)
 /* note: only defined in configure when HAVE_DLFCN_H is true and dlopen can be linked */
 #include <dlfcn.h>
 
-#define lt_dlopen(x)	dlopen(x, RTLD_LAZY | RTLD_GLOBAL)
 #define lt_dlsym(x,y)	dlsym(x, y)
 #define lt_dlclose(x)	dlclose(x)
 #define lt_dlerror()	dlerror()
@@ -171,6 +161,10 @@ static char			*call_filename_buff;
 static lt_dlhandle		mainhandle;
 #endif
 
+#if !defined(_WIN32) && !defined(USE_LIBDL)
+static lt_dladvise advise = NULL;
+#endif
+
 static size_t			call_lastsize;
 static size_t			resolve_size = 0;
 static unsigned int		cob_jmp_primed;
@@ -279,7 +273,8 @@ set_resolve_error (int module_type)
 	}
 }
 
-static int last_entry_is_working_directory (const char *buff, const char *pstr)
+static int
+last_entry_is_working_directory (const char *buff, const char *pstr)
 {
 	const size_t pos = pstr - buff;	/* always > 2 */
 	if (buff[pos - 1] == '.'
@@ -289,6 +284,44 @@ static int last_entry_is_working_directory (const char *buff, const char *pstr)
 	return 0;
 }
 
+static void*
+cob_dlopen (const char* filename)
+{
+#if	defined (_WIN32)
+	if (filename == NULL) {
+		return GetModuleHandle (NULL);
+	}
+	return LoadLibrary (filename);
+#elif	defined(USE_LIBDL)
+	const int flags = cobsetptr->cob_load_global
+		? RTLD_LAZY | RTLD_GLOBAL
+		: RTLD_LAZY | RTLD_LOCAL;
+
+	return dlopen (filename, flags);
+#else
+	if (advise != NULL) {
+		static int last_cob_load_global = -1;
+
+		if (cobsetptr->cob_load_global != last_cob_load_global) {
+			int error;
+			last_cob_load_global = cobsetptr->cob_load_global
+
+			if (cobsetptr->cob_load_global) {
+				error = lt_dladvise_global (&advise);
+			} else {
+				error = lt_dladvise_local (&advise);
+			}
+
+			if (error) {
+				cob_runtime_warning ("set link loader hint failed; %s", lt_dlerror());
+			}
+		}
+	}
+
+	return lt_dlopenadvise (filename, advise);
+#endif
+}
+
 /* resolves the actual library path used from
    * COB_LIBRARY_PATH runtime setting
    * "." as current working direktory [if not included already: prefixed]
@@ -555,9 +588,20 @@ add_to_preload (const char *path, lt_dlhandle libhandle, struct struct_handle *l
 		base_preload_ptr = preptr;
 	}
 #else
-	COB_UNUSED (last_elem);
-	preptr->next = base_preload_ptr;
-	base_preload_ptr = preptr;
+	/* Use the same logic as above in case the cob_load_global is set to local */
+	if (!cobsetptr->cob_load_global) {
+		if (last_elem) {
+			last_elem->next = preptr;
+		} else {
+			preptr->next = NULL;
+			base_preload_ptr = preptr;
+		}
+	} else {
+		COB_UNUSED (last_elem);
+		preptr->next = base_preload_ptr;
+		base_preload_ptr = preptr;
+	}
+
 #endif
 
 	if (!cobsetptr->cob_preload_str) {
@@ -595,6 +639,9 @@ cache_preload (const char *path)
 		/* Save last element of preload list */
 		if (!preptr->next) last_elem = preptr;
 #endif
+		if (!cobsetptr->cob_load_global) {
+			if (!preptr->next) last_elem = preptr;
+		}
 	}
 
 	/* Check for duplicate in already loaded programs;
@@ -624,7 +671,7 @@ cache_preload (const char *path)
 		return 0;
 	}
 
-	libhandle = lt_dlopen (path);
+	libhandle = cob_dlopen (path);
 	if (!libhandle) {
 		cob_runtime_warning (
 			_("preloading from existing path '%s' failed; %s"), path, lt_dlerror());
@@ -854,7 +901,7 @@ cob_resolve_internal  (const char *name, const char *dirent,
 	}
 
 #if	0	/* RXWRXW RTLD */
-#if	defined(USE_LIBDL) && defined (RTLD_DEFAULT)
+#if	defined(USE_LIBDL) && defined(RTLD_DEFAULT)
 	func = lt_dlsym (RTLD_DEFAULT, call_entry_buff);
 	if (func != NULL) {
 		insert (name, func, NULL, NULL, NULL, 1);
@@ -870,7 +917,7 @@ cob_resolve_internal  (const char *name, const char *dirent,
 	for (p = call_filename_buff; *p; ++p) {
 		*p = (cob_u8_t)toupper(*p);
 	}
-	handle = lt_dlopen (call_filename_buff);
+	handle = cob_dlopen (call_filename_buff);
 	if (handle != NULL) {
 		/* Candidate for future calls */
 		cache_dynload (call_filename_buff, handle);
@@ -913,7 +960,7 @@ cob_resolve_internal  (const char *name, const char *dirent,
 			return NULL;
 		}
 		lt_dlerror ();	/* clear last error conditions */
-		handle = lt_dlopen (call_filename_buff);
+		handle = cob_dlopen (call_filename_buff);
 		if (handle != NULL) {
 			/* Candidate for future calls */
 			cache_dynload (call_filename_buff, handle);
@@ -946,7 +993,7 @@ cob_resolve_internal  (const char *name, const char *dirent,
 		call_filename_buff[COB_NORMAL_MAX] = 0;
 		if (access (call_filename_buff, R_OK) == 0) {
 			lt_dlerror ();	/* clear last error conditions */
-			handle = lt_dlopen (call_filename_buff);
+			handle = cob_dlopen (call_filename_buff);
 			if (handle != NULL) {
 				/* Candidate for future calls */
 				cache_dynload (call_filename_buff, handle);
@@ -1706,6 +1753,15 @@ cob_exit_call (void)
 #endif
 #endif
 
+#if !defined(_WIN32) && !defined(USE_LIBDL)
+	if (advise != NULL) {
+		if (lt_dladvise_destroy (&advise)) {
+			/* not translated as highly unlikely */
+			cob_runtime_warning (
+				"destroying link loader advise failed; %s", lt_dlerror ());
+		}
+	}
+#endif
 }
 
 /* try to load specified module from all entries in COB_LIBRARY_PATH
@@ -1793,12 +1849,20 @@ cob_init_call (cob_global *lptr, cob_settings* sptr, const int check_mainhandle)
 
 	lt_dlinit ();
 
+#if !defined(_WIN32) && !defined(USE_LIBDL)
+	if (lt_dladvise_init (&advise) != 0) {
+		/* not translated as highly unlikely */
+		cob_runtime_warning (
+ 			"init link loader advise failed; %s", lt_dlerror ());
+	}
+#endif
+
 #ifndef	COB_BORKED_DLOPEN
 	/* only set main handle if not started by cobcrun as this
 	   saves a check for exported functions in every CALL
 	*/
 	if (check_mainhandle) {
-		mainhandle = lt_dlopen (NULL);
+		mainhandle = cob_dlopen (NULL);
 	} else {
 		mainhandle = NULL;
 	}

libcob/coblocal.h

@@ -306,6 +306,7 @@ typedef struct __cob_settings {
 
 	/* call.c */
 	int	cob_physical_cancel;	/* 0 "= "logical only" (default), 1 "also unload", -1 "never unload" */
+	unsigned int	cob_load_global; /* hint for dynamic linker to make symbols available 0=global, 1=local */
 	unsigned int	name_convert;
 	char		*cob_preload_str;
 	char		*cob_library_path;

libcob/common.c

@@ -549,6 +549,9 @@ static struct config_tbl gc_conf[] = {
 	{"LOGICAL_CANCELS", "logical_cancels", 	NULL, NULL, GRP_HIDE, ENV_BOOL | ENV_NOT, SETPOS (cob_physical_cancel)},
 	{"COB_LIBRARY_PATH", "library_path", 	NULL, 	NULL, GRP_CALL, ENV_PATH, SETPOS (cob_library_path)}, /* default value set in cob_init_call() */
 	{"COB_PRE_LOAD", "pre_load", 		NULL, 	NULL, GRP_CALL, ENV_STR, SETPOS (cob_preload_str)},
+#ifndef _WIN32
+	{"COB_LOAD_GLOBAL", "load_global", "0", NULL, GRP_CALL, ENV_BOOL, SETPOS(cob_load_global)},
+#endif
 	{"COB_BELL", "bell", 			"0", 	beepopts, GRP_SCREEN, ENV_UINT | ENV_ENUMVAL, SETPOS (cob_beep_value)},
 	{"COB_DEBUG_LOG", "debug_log", 		NULL, 	NULL, GRP_HIDE, ENV_FILE, SETPOS (cob_debug_log)},
 	{"COB_DISABLE_WARNINGS", "disable_warnings", "0", 	NULL, GRP_MISC, ENV_BOOL | ENV_NOT, SETPOS (cob_display_warn)},