Merge SVN 4883

cobc/ChangeLog

@@ -255,6 +255,16 @@
 	  and the related BYTE-LENGTH clause
 	* field.c, tree.c, typeck.c: minimal adjustments for PIC U
 
+2022-12-16  Simon Sobisch <[email protected]>
+
+	* tree.h (cb_binary_op, cb_binary_op_flag, cb_binary_op_op): changed struct
+	  cb_binary_op to use new enums for the operation and for "special flags"
+	* tree.h (BOP_OPERANDS_SWAPPED), codegen.c (output_cond), typeck.c
+	  (cb_build_cond, swap_condition_operands): store flag when swap operation
+	  is done and swap the result for return values as used in SEARCH ALL later
+	* codegen.c (output_long_integer): reduce scope of variables as done
+	  in (output_integer)
+
 2022-12-15  Simon Sobisch <[email protected]>
 
 	* codegen.c (output_initialize_to_value): fix bad generation for VALUE size
@@ -283,7 +293,6 @@
 	* 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]>
 
 	* typeck.c (validate_move): fix bug #643 add check for SET literal TO val

cobc/codegen.c

@@ -3378,7 +3378,7 @@ output_integer (cb_tree x)
 		break;
 	case CB_TAG_BINARY_OP: {
 		const struct cb_binary_op *p = CB_BINARY_OP (x);
-		if (p->flag) {
+		if (p->flag == BOP_RESOLVE_AS_INTEGER) {
 			if (!cb_fits_int (p->x) || !cb_fits_int (p->y)) {
 				output ("cob_get_int (");
 				output_param (x, -1);
@@ -3685,10 +3685,6 @@ output_integer (cb_tree x)
 static void
 output_long_integer (cb_tree x)
 {
-	struct cb_binary_op	*p;
-	struct cb_cast		*cp;
-	struct cb_field		*f;
-
 	switch (CB_TREE_TAG (x)) {
 	case CB_TAG_CONST:
 		if (x == cb_zero) {
@@ -3714,9 +3710,9 @@ output_long_integer (cb_tree x)
 	case CB_TAG_LITERAL:
 		output (CB_FMT_LLD_F, cb_get_long_long (x));
 		break;
-	case CB_TAG_BINARY_OP:
-		p = CB_BINARY_OP (x);
-		if (p->flag) {
+	case CB_TAG_BINARY_OP: {
+		const struct cb_binary_op *p = CB_BINARY_OP (x);
+		if (p->flag == BOP_RESOLVE_AS_INTEGER) {
 			if (!cb_fits_long_long (p->x) 
 			 || !cb_fits_long_long (p->y)) {
 				output ("cob_get_llint (");
@@ -3740,8 +3736,9 @@ output_long_integer (cb_tree x)
 			output (")");
 		}
 		break;
-	case CB_TAG_CAST:
-		cp = CB_CAST (x);
+	}
+	case CB_TAG_CAST: {
+		const struct cb_cast *cp = CB_CAST (x);
 		switch (cp->cast_type) {
 		case CB_CAST_ADDRESS:
 			output ("(");
@@ -3766,8 +3763,9 @@ output_long_integer (cb_tree x)
 		/* LCOV_EXCL_STOP */
 		}
 		break;
-	case CB_TAG_REFERENCE:
-		f = cb_code_field (x);
+	}
+	case CB_TAG_REFERENCE: {
+		struct cb_field *f = cb_code_field (x);
 		switch (f->usage) {
 		case CB_USAGE_INDEX:
 			if (f->index_type != CB_NORMAL_INDEX) {
@@ -3913,6 +3911,7 @@ output_long_integer (cb_tree x)
 
 		output_func_1 ("cob_get_llint", x);
 		break;
+	}
 	case CB_TAG_INTRINSIC:
 		output ("cob_get_llint (");
 		output_param (x, -1);
@@ -4876,12 +4875,13 @@ output_func_1 (const char *name, cb_tree x)
 
 /* Condition */
 
+/* output condition 'x' with optional storage in
+   C field "ret" depending on 'save_flag' */
 static void
 output_cond (cb_tree x, const int save_flag)
 {
-	struct cb_binary_op	*p;
-
 	in_cond = 1;
+
 	switch (CB_TREE_TAG (x)) {
 	case CB_TAG_CONST:
 		if (x == cb_true) {
@@ -4895,8 +4895,8 @@ output_cond (cb_tree x, const int save_flag)
 		}
 		/* LCOV_EXCL_STOP */
 		break;
-	case CB_TAG_BINARY_OP:
-		p = CB_BINARY_OP (x);
+	case CB_TAG_BINARY_OP: {
+		const struct cb_binary_op	*p = CB_BINARY_OP (x);
 		switch (p->op) {
 		case '!':
 			output ("!");
@@ -4922,7 +4922,12 @@ output_cond (cb_tree x, const int save_flag)
 		case ']':
 		case '~':
 			output ("((int)");
-			output_cond (p->x, save_flag);
+			if (save_flag
+				&& p->flag == BOP_OPERANDS_SWAPPED) {
+				output_cond (p->x, 2);
+			} else {
+				output_cond (p->x, save_flag);
+			}
 			switch (p->op) {
 			case '=':
 				output (" == 0");
@@ -4954,9 +4959,15 @@ output_cond (cb_tree x, const int save_flag)
 			break;
 		}
 		break;
+	}
 	case CB_TAG_FUNCALL:
 		if (save_flag) {
-			output ("(ret = ");
+			/* handle original swapped function */
+			if (save_flag == 2) {
+				output ("(ret = -");
+			} else {
+				output ("(ret = ");
+			}
 		}
 		output_funcall (x);
 		if (save_flag) {
@@ -4965,7 +4976,12 @@ output_cond (cb_tree x, const int save_flag)
 		break;
 	case CB_TAG_LIST:
 		if (save_flag) {
-			output ("(ret = ");
+			/* handle original swapped function */
+			if (save_flag == 2) {
+				output ("(ret = -");
+			} else {
+				output ("(ret = ");
+			}
 		}
 		inside_stack[inside_check++] = 0;
 		/* LCOV_EXCL_START */
@@ -4993,6 +5009,7 @@ output_cond (cb_tree x, const int save_flag)
 		CB_TREE_TAG_UNEXPECTED_ABORT (x);
 	/* LCOV_EXCL_STOP */
 	}
+
 	in_cond = 0;
 }
 

cobc/tree.h

@@ -1264,30 +1264,35 @@ struct cb_reference {
 
 /* Binary operation */
 
-/*
-  '+'	x + y
-  '-'	x - y
-  '*'	x * y
-  '/'	x / y
-  '^'	x ** y
-  '='	x = y
-  '>'	x > y
-  '<'	x < y
-  '['	x <= y
-  ']'	x >= y
-  '~'	x != y
-  '!'	not x
-  '&'	x and y
-  '|'	x or y
-  '@'	( x )
-*/
+enum cb_binary_op_op {
+	BOP_PLUS	= '+',	/* x + y */
+	BOP_MINUS	= '-',	/* x - y */
+	BOP_MULT	= '*',	/* x * y */
+	BOP_DIV		= '/',	/* x / y */
+	BOP_POW 	= '^',	/* x ** y */
+	BOP_EQ		= '=',	/* x = y */
+	BOP_GT		= '>',	/* x > y */
+	BOP_LT		= '<',	/* x < y */
+	BOP_LE		= '[',	/* x <= y */
+	BOP_GE		= ']',	/* x >= y */
+	BOP_NE		= '~',	/* x != y */
+	BOP_NOT		= '!',	/* not x */
+	BOP_AND		= '&',	/* x and y */
+	BOP_OR		= '|',	/* x or y */
+	BOP_PARENS	= '@'	/* ( x ) */
+};
+
+enum cb_binary_op_flag {
+	BOP_RESOLVE_AS_INTEGER = 1,
+	BOP_OPERANDS_SWAPPED = 2
+};
 
 struct cb_binary_op {
 	struct cb_tree_common	common;		/* Common values */
 	cb_tree			x;		/* LHS */
 	cb_tree			y;		/* RHS */
-	int			op;		/* Operation */
-	unsigned int		flag;		/* Special usage */
+	enum cb_binary_op_op	op;		/* Operation */
+	enum cb_binary_op_flag 	flag;		/* Special usage */
 };
 
 #define CB_BINARY_OP(x)		(CB_TREE_CAST (CB_TAG_BINARY_OP, struct cb_binary_op, x))

cobc/typeck.c

@@ -2603,9 +2603,10 @@ cb_build_identifier (cb_tree x, const int subchk)
 	}
 
 	for (l = r->subs; l; l = CB_CHAIN (l)) {
-		if (CB_BINARY_OP_P (CB_VALUE (l))) {
+		cb_tree val = CB_VALUE (l);
+		if (CB_BINARY_OP_P (val)) {
 			/* Set special flag for codegen */
-			CB_BINARY_OP(CB_VALUE(l))->flag = 1;
+			CB_BINARY_OP (val)->flag = BOP_RESOLVE_AS_INTEGER;
 		}
 	}
 
@@ -7341,6 +7342,8 @@ swap_condition_operands (struct cb_binary_op *p)
 {
 	cb_tree y = p->x;
 
+	p->flag = BOP_OPERANDS_SWAPPED;
+
 	p->x = p->y;
 	p->y = y;
 
@@ -7439,6 +7442,9 @@ cb_build_cond (cb_tree x)
 				break;
 			}
 			ret = cb_build_binary_op (ret, p->op, p->y);
+			if (CB_VALID_TREE (ret)) {
+				CB_BINARY_OP (ret)->flag = p->flag;
+			}
 		}
 		if (ret != cb_true && ret != cb_false) {
 			cb_copy_source_reference (ret, x);