Merge SVN 4879

cobc/ChangeLog

@@ -278,6 +278,10 @@
 	  fields with ANY LENGTH
 	* typeck.c (cb_build_cond_default, cb_build_cond_fields): extracted
 	  from cb_build_cond
+	* typeck.c (swap_condition_operands): added and executed in cb_build_cond
+	  if left side is constant or literal
+	* typeck.c (cb_build_cond_fields): optimize comparison between field and
+	  SPACES up to COB_SPACES_ALPHABETIC_BYTE_LENGTH
 
 
 2022-12-14  Simon Sobisch <[email protected]>

cobc/typeck.c

@@ -7170,6 +7170,14 @@ cb_build_cond_fields (struct cb_binary_op *p,
 	if (right == cb_zero && l_class == CB_CLASS_NUMERIC) {
 		return cb_build_optim_cond (p);
 	}
+	if (right == cb_space
+	 && (l_class == CB_CLASS_ALPHANUMERIC || l_class == CB_CLASS_ALPHABETIC)
+	 && (size1 > 0 && size1 <= COB_SPACES_ALPHABETIC_BYTE_LENGTH)) {
+		return CB_BUILD_FUNCALL_3 ("memcmp",
+			CB_BUILD_CAST_ADDRESS (left),
+			cb_build_direct ("COB_SPACES_ALPHABETIC", 0),
+			cb_int (size1));
+	}
 	return CB_BUILD_FUNCALL_2 ("cob_cmp", left, right);
 }
 
@@ -7323,6 +7331,20 @@ cb_build_cond_default (struct cb_binary_op *p, cb_tree left, cb_tree right)
 	return cb_build_cond_fields (p, left, right, l_class);
 }
 
+static void
+swap_condition_operands (struct cb_binary_op *p)
+{
+	cb_tree y = p->x;
+
+	p->x = p->y;
+	p->y = y;
+
+	if (p->op == '>') p->op = '<';
+	else if (p->op == '<') p->op = '>';
+	else if (p->op == '[') p->op = ']';
+	else if (p->op == ']') p->op = '[';
+}
+
 cb_tree
 cb_build_cond (cb_tree x)
 {
@@ -7401,6 +7423,12 @@ cb_build_cond (cb_tree x)
 			if (!p->y || p->y == cb_error_node) {
 				return cb_error_node;
 			}
+			/* move figurative constants and literals to the right for comparision */
+			if (cb_flag_fast_compare
+			 &&  (CB_CONST_P (p->x) || CB_LITERAL_P (p->x))
+			 && !(CB_CONST_P (p->y) || CB_LITERAL_P (p->y))) {
+				swap_condition_operands (p);
+			}
 			ret = cb_build_cond_default (p, p->x, p->y);
 			if (CB_FUNCALL_P(ret) && !strcmp(CB_FUNCALL(ret)->name, "$:")) {
 				break;

libcob/ChangeLog

@@ -261,6 +261,20 @@
 	* fileio.c [!COB_EXPERIMENTAL]: disable "new" status 0P via preprocessor
 	  to inspect later for either include as COB_LS_VALIDATE=PRINT or drop
 
+2022-12-15  Simon Sobisch <[email protected]>
+
+	* common.c, common.h: new external field + define
+	  COB_SPACES_ALPHABETIC / COB_SPACES_ALPHABETIC_BYTE_LENGTH
+	* common.c: split sort_compare to variant with and without collation,
+	  using direct memcmp for the later
+	* common.c (compare_spaces, compare_character): new function used for
+	  comparison of data without collation using memcmp in doubled areas
+	  instead of looping over every character
+	* common.c (cob_cmp_alnum, cob_cmp_all): use direct memcmp and new
+	  functions if no collation was specified
+	* common.c (common_cmpc, common_cmps): always use collation as all
+	  callers left in pass it (and otherwise call the new functions)
+
 2022-12-13  David Declerck <[email protected]>
 
 	* cconv.c: file moved from cobc to libcob

libcob/common.c

@@ -183,6 +183,17 @@
 #define COB_MAX_ALLOC_SIZE COB_MAX_FIELD_SIZE
 #endif
 
+/* Global variables */
+#define SPACE_16	"                "
+#define SPACE_64	SPACE_16 SPACE_16 SPACE_16 SPACE_16
+#define SPACE_256	SPACE_64 SPACE_64 SPACE_64 SPACE_64
+#define SPACE_1024	SPACE_256 SPACE_256 SPACE_256 SPACE_256
+const char *COB_SPACES_ALPHABETIC = SPACE_1024;
+#undef SPACE_16
+#undef SPACE_64
+#undef SPACE_256
+#undef SPACE_1024
+
 struct cob_alloc_cache {
 	struct cob_alloc_cache	*next;		/* Pointer to next */
 	void			*cob_pointer;	/* Pointer to malloced space */
@@ -1751,63 +1762,89 @@ cob_put_sign_ebcdic (unsigned char *p, const int sign)
 }
 
 /* compare up to 'size' characters from buffer 'p'
-   against a single character 'c',
-   optionally using collation 'col' */
+   to a single character 'c',
+   using collation 'col' */
 static int
 common_cmpc (const unsigned char *p, const unsigned int c,
 	     const size_t size, const unsigned char *col)
 {
 	register const unsigned char *end = p + size;
 	int			ret;
 
-	if (col) {
-		const unsigned char c_col = col[c];
-		while (p < end) {
-			if ((ret = col[*p] - c_col) != 0) {
-				return ret;
-			}
-			p++;
-		}
-	} else {
-		while (p < end) {
-			if ((ret = *p - c) != 0) {
-				return ret;
-			}
-			p++;
+	const unsigned char c_col = col[c];
+	while (p < end) {
+		if ((ret = col[*p] - c_col) != 0) {
+			return ret;
 		}
+		p++;
 	}
 	return 0;
 }
 
+/* compare up to 'size' characters in 's1' to 's2'
+   using collation 'col' */
 static int
 common_cmps (const unsigned char *s1, const unsigned char *s2,
 	     const size_t size, const unsigned char *col)
 {
 	register const unsigned char *end = s1 + size;
 	int			ret;
-
-	if (col) {
-		while (s1 < end) {
-			if ((ret = col[*s1] - col[*s2]) != 0) {
-				return ret;
-			}
-			s1++, s2++;
+	while (s1 < end) {
+		if ((ret = col[*s1] - col[*s2]) != 0) {
+			return ret;
 		}
-	} else {
-		while (s1 < end) {
-			if ((ret = *s1 - *s2) != 0) {
-				return ret;
-			}
-			s1++, s2++;
+		s1++, s2++;
+	}
+	return 0;
+}
+
+/* compare up to 'size' characters in 'data' to characters
+   in 'c' with size 'compare_size' */
+static int
+compare_character (const unsigned char *data, size_t size,
+	const unsigned char *c, size_t compare_size)
+{
+	const unsigned char	*p;
+	int 		ret;
+	if ((ret = memcmp (data, c, compare_size)) != 0) {
+		return ret;
+	}
+
+	p = data;
+	size = size - compare_size;
+
+	while (size > compare_size) {
+		p = data + compare_size;
+		if ((ret = memcmp (p, data, compare_size)) != 0) {
+			return ret;
 		}
+		size = size - compare_size;
+		compare_size *= 2;
+	}
+	if (size > 0) {
+		return memcmp (p, data, size);
 	}
 	return 0;
 }
 
+/* compare up to 'size' characters in 'data' to spaces */
+static int
+compare_spaces (const unsigned char *data, size_t size)
+{
+	if (size <= COB_SPACES_ALPHABETIC_BYTE_LENGTH) {
+		return memcmp (data, COB_SPACES_ALPHABETIC, size);
+	}
+	return compare_character (data, size,
+		(const unsigned char *)COB_SPACES_ALPHABETIC,
+		COB_SPACES_ALPHABETIC_BYTE_LENGTH);
+
+}
+
+/* compare content of field 'f1' to repeated content of 'f2' */
 static int
 cob_cmp_all (cob_field *f1, cob_field *f2)
 {
-	const unsigned char	*s = COB_MODULE_PTR->collating_sequence;
+	const unsigned char	*col = COB_MODULE_PTR->collating_sequence;
 	unsigned char		*data;
 	unsigned char		buff[COB_MAX_DIGITS + 1];
 
@@ -1824,53 +1861,87 @@ cob_cmp_all (cob_field *f1, cob_field *f2)
 		data = f1->data;
 	}
 
-	/* check for IF VAR = ALL "9" */
-	if (f2->size == 1) {
-		return common_cmpc (data, f2->data[0], f1->size, s);
+	/* check without collation */
+	if (col == NULL) {
+		if (f2->size == 1
+		 && f2->data[0] == ' ') {
+			/* check for IF VAR = [ALL] SPACES */
+			return compare_spaces (f1->data, f1->size);
+		}
+		/* check for IF VAR = ALL ... / HIGH-VALUE / ... */
+		return compare_character (f1->data, f1->size, f2->data, f2->size);
 	}
 
-	/* check for IF VAR = ALL "AB" ... */
-	{
+	/* check with collation */
+	if (f2->size == 1) {
+		/* check for IF VAR = ALL "9" */
+		return common_cmpc (data, f2->data[0], f1->size, col);
+	} else {
+		/* check for IF VAR = ALL "AB" ... */
 		size_t		size = f1->size;
-		int			ret;
-
+		int 		ret;
 		while (size >= f2->size) {
-			if ((ret = common_cmps (data, f2->data, f2->size, s)) != 0) {
+			if ((ret = common_cmps (data, f2->data, f2->size, col)) != 0) {
 				return ret;
 			}
 			size -= f2->size;
 			data += f2->size;
 		}
 		if (size > 0) {
-			return common_cmps (data, f2->data, size, s);
+			return common_cmps (data, f2->data, size, col);
 		}
 	}
-
 	return 0;
 }
 
+/* compare content of field 'f1' to content of 'f2', space padded,
+   using the optional collating sequence of the program */
 static int
 cob_cmp_alnum (cob_field *f1, cob_field *f2)
 {
-	const unsigned char	*s = COB_MODULE_PTR->collating_sequence;
+	const unsigned char	*col = COB_MODULE_PTR->collating_sequence;
 	const size_t	min = (f1->size < f2->size) ? f1->size : f2->size;
 	int		ret;
 
-	/* Compare common substring */
-	if ((ret = common_cmps (f1->data, f2->data, min, s)) != 0) {
-		return ret;
-	}
+	if (col == NULL) {		/* check without collation */
+
+		/* Compare common substring */
+		if ((ret = memcmp (f1->data, f2->data, min)) != 0) {
+			return ret;
+		}
+
+		/* Compare the rest (if any) with spaces */
+		if (f1->size > f2->size) {
+			const size_t spaces_to_test = f1->size - min;
+			return compare_spaces (f1->data + min, spaces_to_test);
+		} else if (f1->size < f2->size) {
+			const size_t spaces_to_test = f2->size - min;
+			return -compare_spaces (f1->data + min, spaces_to_test);
+		}
+
+	} else {		/* check with collation */
+
+		/* Compare common substring */
+		if ((ret = common_cmps (f1->data, f2->data, min, col)) != 0) {
+			return ret;
+		}
+
+		/* Compare the rest (if any) with spaces */
+		if (f1->size > f2->size) {
+			const size_t spaces_to_test = f1->size - min;
+			return common_cmpc (f1->data + min, ' ', spaces_to_test, col);
+		} else if (f1->size < f2->size) {
+			const size_t spaces_to_test = f2->size - min;
+			return -common_cmpc (f2->data + min, ' ', spaces_to_test, col);
+		}
 
-	/* Compare the rest (if any) with spaces */
-	if (f1->size > f2->size) {
-		return common_cmpc (f1->data + min, ' ', f1->size - min, s);
-	} else if (f1->size < f2->size) {
-		return -common_cmpc (f2->data + min, ' ', f2->size - min, s);
 	}
 
 	return 0;
 }
 
+/* comparision of all key fields for SORT (without explicit collation)
+   in records pointed to by 'data1' and 'data2' */
 static int
 sort_compare (const void *data1, const void *data2)
 {
@@ -1879,6 +1950,32 @@ sort_compare (const void *data1, const void *data2)
 	cob_field	f1;
 	cob_field	f2;
 
+	for (i = 0; i < sort_nkeys; ++i) {
+		f1 = f2 = *sort_keys[i].field;
+		f1.data = (unsigned char *)data1 + sort_keys[i].offset;
+		f2.data = (unsigned char *)data2 + sort_keys[i].offset;
+		if (COB_FIELD_IS_NUMERIC (&f1)) {
+			res = cob_numeric_cmp (&f1, &f2);
+		} else {
+			res = memcmp (f1.data, f2.data, f1.size);
+		}
+		if (res != 0) {
+			return (sort_keys[i].tf_ascending == COB_ASCENDING) ? res : -res;
+		}
+	}
+	return 0;
+}
+
+/* comparision of all key fields for SORT (with explicit collation)
+   in records pointed to by 'data1' and 'data2' */
+static int
+sort_compare_collate (const void *data1, const void *data2)
+{
+	size_t		i;
+	int		res;
+	cob_field	f1;
+	cob_field	f2;
+
 	for (i = 0; i < sort_nkeys; ++i) {
 		f1 = f2 = *sort_keys[i].field;
 		f1.data = (unsigned char *)data1 + sort_keys[i].offset;
@@ -4367,7 +4464,11 @@ cob_table_sort_init_key (cob_field *field, const int flag,
 void
 cob_table_sort (cob_field *f, const int n)
 {
-	qsort (f->data, (size_t) n, f->size, sort_compare);
+	if (sort_collate) {
+		qsort (f->data, (size_t) n, f->size, sort_compare_collate);
+	} else {
+		qsort (f->data, (size_t) n, f->size, sort_compare);
+	}
 	cob_free (sort_keys);
 }
 
@@ -9708,7 +9809,7 @@ print_info_detailed (const int verbose)
 	   may interfer with other output */
 #if defined (COB_GEN_SCREENIO)
 	mouse_support = get_screenio_and_mouse_info
-	((char*)&screenio_info, sizeof (screenio_info), verbose);
+		((char*)&screenio_info, sizeof (screenio_info), verbose);
 #else
 	snprintf ((char *)&screenio_info, sizeof(screenio_info) - 1,
 		"%s", _("disabled"));

libcob/common.h

@@ -2143,6 +2143,9 @@ COB_EXPIMP void cob_unstring_into	(cob_field *, cob_field *, cob_field *);
 COB_EXPIMP void cob_unstring_tallying	(cob_field *);
 COB_EXPIMP void cob_unstring_finish	(void);
 
+COB_EXPIMP const char *COB_SPACES_ALPHABETIC;	/* PIC X/A/U SPACES */
+#define COB_SPACES_ALPHABETIC_BYTE_LENGTH 1024
+
 /*******************************/
 /*   Functions in move.c       */
 /*******************************/