minor performance-tweak for get/set int:

libcob:
* move.c: add const_bin_attr, add COB_FLAG_REAL_BINARY to const_binll_attr
* move.c, common.h: new function cob_set_llint
* move.c (cob_set_int): use const_bin_attr instead of setting it up each time as this function is used quite often in generated code
* move.c (cob_get_int, cob_get_llint): use of constant binary attributes
* move.c (indirect_move, cob_set_int, cob_set_llint, cob_get_int, cob_get_llint): minor refactoring to use COB_FIELD_INIT

bin/cobcrun.c

@@ -1,5 +1,5 @@
 /*
-   Copyright (C) 2004-2012, 2014-2022 Free Software Foundation, Inc.
+   Copyright (C) 2004-2012, 2014-2023 Free Software Foundation, Inc.
    Written by Roger While, Simon Sobisch, Brian Tiffin
 
    This file is part of GnuCOBOL.
@@ -96,7 +96,7 @@ cobcrun_print_version (void)
 	}
 
 	printf ("cobcrun (%s) %s.%d\n", PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL);
-	puts ("Copyright (C) 2022 Free Software Foundation, Inc.");
+	puts ("Copyright (C) 2023 Free Software Foundation, Inc.");
 	printf (_("License GPLv3+: GNU GPL version 3 or later <%s>"), "https://gnu.org/licenses/gpl.html");
 	putchar ('\n');
 	puts (_("This is free software; see the source for copying conditions.  There is NO\n"
@@ -195,7 +195,7 @@ cobcrun_initial_module (char *module_argument)
 	          after allowing module with path in COB_PRE_LOAD */
 
 	/* LCOV_EXCL_START */
-	if (!module_argument) {
+	if (!module_argument || !module_argument[0]) {
 		/* never reached (getopt ensures that we have an argument),
 		   just in to keep the analyzer happy, so msg untranslated */
 		return "missing argument";
@@ -213,8 +213,8 @@ cobcrun_initial_module (char *module_argument)
 	/* See if we have a /dir/path/module, or a /dir/path/ or a module (no slash) */
 	cobcrun_split_path_file (&pathname, &filename, module_argument);
 	if (*pathname) {
-		/* TODO: check content, see libcob/common.h */
-		envptr = getenv ("COB_LIBRARY_PATH");
+		/* TODO: check content, see libcob/common.c/h to raise error message */
+		envptr = cob_getenv_direct ("COB_LIBRARY_PATH");
 		if (envptr
 		 && strlen (envptr) + strlen (pathname) + 1 < COB_MEDIUM_MAX) {
 			memset (env_space, 0, COB_MEDIUM_BUFF);
@@ -229,8 +229,8 @@ cobcrun_initial_module (char *module_argument)
 	cob_free((void *)pathname);
 
 	if (*filename) {
-		/* TODO: check content, see libcob/common.h */
-		envptr = getenv ("COB_PRE_LOAD");
+		/* TODO: check content, see libcob/common.c/h to raise error message */
+		envptr = cob_getenv_direct ("COB_PRE_LOAD");
 		if (envptr
 		 && strlen (envptr) + strlen (filename) + 1 < COB_MEDIUM_MAX) {
 			memset (env_space, 0, COB_MEDIUM_BUFF);
@@ -256,7 +256,7 @@ process_command_line (int argc, char *argv[])
 	const char		*err_msg;
 
 #if defined (_WIN32) || defined (__DJGPP__)
-	if (!getenv ("POSIXLY_CORRECT")) {
+	if (!cob_getenv_direct ("POSIXLY_CORRECT")) {
 		/* Translate command line arguments from DOS/WIN to UNIX style */
 		int argnum = 0;
 		while (++argnum < argc) {

libcob/ChangeLog

@@ -8,12 +8,15 @@
 	  minimal editing (via move.c)
 	* common.c (cob_move_to_group_as_alnum): new function to handle MOVE to
 	  group as MOVE to alphanumeric field, used in functions above
-	* common.c (cob_display_arg_number, cob_accept_arg_number, cob_cmp):
-	  minor refactoring to use COB_FIELD_INIT
+	* common.c (cob_display_arg_number, cob_accept_arg_number, cob_cmp),
+	  move.c (indirect_move, cob_set_int, cob_set_llint, cob_get_int,
+	  cob_get_llint): minor refactoring to use COB_FIELD_INIT
 	* common.c (check_current_date, cob_get_current_datetime),
 	  coblocal.h (cob_settings->cob_time_constant_is_calculated):
 	  skip expensive call to localtime + mktime if COB_CURRENT_DATE is
 	  set and "complete", by doing it already for the constant
+	* move.c: integration of changes from 2022-04-08
+	* move.c (cob_get_int, cob_get_llint): use of constant binary attributes
 
 2023-01-02  Simon Sobisch <[email protected]>
 
@@ -537,6 +540,10 @@
 	  check and marker range before checking all marker bytes in range
 	* strings.c: increase use of direct pointer comparisons instead of
 	  accessing char arrays or its positions for INSPECT
+	* move.c: add const_bin_attr, add COB_FLAG_REAL_BINARY to const_binll_attr
+	* move.c, common.h: new function cob_set_llint
+	* move.c (cob_set_int): use const_bin_attr instead of setting it up
+	  each time as this function is used quite often in generated code
 
 2022-04-29  Simon Sobisch <[email protected]>
 
@@ -901,6 +908,8 @@
 	* move.c: use of COB_D2I for conversions
 	  and restore previous one afterwards
 	* move.c (store_common_region): minor refactoring
+	* numeric.c, common.c: clear use and separation of "sign" (GMP view) vs.
+	  "flag_sign" (field attribute) vs. "has_negative_sign"
 
 2021-01-28  Simon Sobisch <[email protected]>
 

libcob/common.c

@@ -5348,11 +5348,11 @@ static COB_INLINE COB_A_INLINE int
 setenv (const char *name, const char *value, int overwrite) {
 	/* remark: _putenv_s does always overwrite, add a check for overwrite = 1 if necessary later */
 	COB_UNUSED (overwrite);
-	return _putenv_s (name,value);
+	return _putenv_s (name, value);
 }
 static COB_INLINE COB_A_INLINE int
 unsetenv (const char *name) {
-	return _putenv_s (name,"");
+	return _putenv_s (name, "");
 }
 #endif
 

libcob/common.h

@@ -1913,6 +1913,7 @@ COB_EXPIMP void		cob_move_ibm	(void *, void *, const int);
 COB_EXPIMP void		cob_init_table	(void *, const size_t, const size_t);
 COB_EXPIMP void		cob_set_int	(cob_field *, const int);
 COB_EXPIMP int		cob_get_int	(cob_field *);
+COB_EXPIMP void		cob_set_llint	(cob_field *, const cob_s64_t);
 COB_EXPIMP cob_s64_t	cob_get_llint	(cob_field *);
 /*************************************************************************/
 /* Functions in move.c for C access to COBOL data - GnuCOBOL COBOL-C-API */

libcob/move.c

@@ -50,9 +50,12 @@ static unsigned char	cob_lc_thou;
 
 static const cob_field_attr	const_alpha_attr =
 				{COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL};
+static const cob_field_attr	const_bin_attr =
+				{COB_TYPE_NUMERIC_BINARY, 9, 0,
+				 COB_FLAG_HAVE_SIGN | COB_FLAG_REAL_BINARY, NULL};
 static const cob_field_attr	const_binll_attr =
 				{COB_TYPE_NUMERIC_BINARY, 20, 0,
-				 COB_FLAG_HAVE_SIGN, NULL};
+				 COB_FLAG_HAVE_SIGN | COB_FLAG_REAL_BINARY, NULL};
 static const cob_field_attr	all_display_attr =
 				{COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL};
 static const cob_field_attr	all_numeric_display_attr =
@@ -1157,17 +1160,15 @@ indirect_move (void (*func) (cob_field *src, cob_field *dst),
 	       cob_field *src, cob_field *dst,
 	       const size_t size, const int scale)
 {
-	cob_field	temp;
+	cob_field	field;
 	cob_field_attr	attr;
 
+	COB_FIELD_INIT (size, cob_malloc (size), &attr);
 	COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, (unsigned short) size, (short) scale,
 			COB_FLAG_HAVE_SIGN, NULL);
-	temp.size = size;
-	temp.data = cob_malloc (size);
-	temp.attr = &attr;
-	func (src, &temp);
-	cob_move (&temp, dst);
-	cob_free (temp.data);
+	func (src, &field);
+	cob_move (&field, dst);
+	cob_free (field.data);
 }
 
 static void
@@ -1741,24 +1742,14 @@ cob_display_get_long_long (cob_field *f)
 void
 cob_set_int (cob_field *f, const int n)
 {
-	cob_field	temp;
-	cob_field_attr	attr;
-
-	COB_ATTR_INIT  (COB_TYPE_NUMERIC_BINARY, 9, 0,
-			COB_FLAG_HAVE_SIGN | COB_FLAG_REAL_BINARY, NULL);
-	temp.size = 4;
-	temp.data = (unsigned char *)&n;
-	temp.attr = &attr;
-	cob_move (&temp, f);
+	cob_field	field;
+	COB_FIELD_INIT (sizeof (int), (unsigned char *)&n, &const_bin_attr);
+	cob_move (&field, f);
 }
 
 int
 cob_get_int (cob_field *f)
 {
-	int		n;
-	cob_s64_t	val;
-	cob_field	temp;
-	cob_field_attr	attr;
 
 	switch (COB_FIELD_TYPE (f)) {
 	case COB_TYPE_NUMERIC_DISPLAY:
@@ -1767,47 +1758,59 @@ cob_get_int (cob_field *f)
 		return cob_packed_get_int (f);
 	case COB_TYPE_NUMERIC_BINARY:
 	case COB_TYPE_NUMERIC_COMP5:
-		val = cob_binary_mget_sint64 (f);
-		for (n = COB_FIELD_SCALE (f); n > 0 && val; --n) {
-			val /= 10;
+		{
+			cob_s64_t	val = cob_binary_mget_sint64 (f);
+			int		inc;
+			for (inc = COB_FIELD_SCALE (f); inc > 0 && val; --inc) {
+				val /= 10;
+			}
+			return (int)val;
 		}
-		return (int)val;
 	default:
-		COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0,
-				COB_FLAG_HAVE_SIGN, NULL);
-		temp.size = 4;
-		temp.data = (unsigned char *)&n;
-		temp.attr = &attr;
-		cob_move (f, &temp);
-		return n;
+		{
+			cob_field	field;
+			int		val;
+			COB_FIELD_INIT (sizeof (int), (unsigned char *)&val, &const_bin_attr);
+			cob_move (f, &field);
+			return val;
+		}
 	}
 }
 
+void
+cob_set_llint (cob_field *f, const cob_s64_t n)
+{
+	cob_field	field;
+	COB_FIELD_INIT (sizeof (cob_s64_t), (unsigned char *)&n, &const_binll_attr);
+	cob_move (&field, f);
+}
+
 cob_s64_t
 cob_get_llint (cob_field *f)
 {
-	cob_s64_t	n;
-	int		inc;
-	cob_field	temp;
-
 	switch (COB_FIELD_TYPE (f)) {
 	case COB_TYPE_NUMERIC_DISPLAY:
 		return cob_display_get_long_long (f);
 	case COB_TYPE_NUMERIC_PACKED:
 		return cob_packed_get_long_long (f);
 	case COB_TYPE_NUMERIC_BINARY:
 	case COB_TYPE_NUMERIC_COMP5:
-		n = cob_binary_mget_sint64 (f);
-		for (inc = COB_FIELD_SCALE (f); inc > 0 && n; --inc) {
-			n /= 10;
+		{
+			cob_s64_t	val = cob_binary_mget_sint64 (f);
+			int		inc;
+			for (inc = COB_FIELD_SCALE (f); inc > 0 && val; --inc) {
+				val /= 10;
+			}
+			return val;
 		}
-		return n;
 	default:
-		temp.size = 8;
-		temp.data = (unsigned char *)&n;
-		temp.attr = &const_binll_attr;
-		cob_move (f, &temp);
-		return n;
+		{
+			cob_field	field;
+			cob_s64_t	val;
+			COB_FIELD_INIT (sizeof (cob_s64_t), (unsigned char *)&val, &const_binll_attr);
+			cob_move (f, &field);
+			return val;
+		}
 	}
 }