PR modula2/118998 Rotate of a packetset causes different types to binary operator error

This patch allow a packedset to be rotated by the system module intrinsic
procedure function.  It ensures that both operands to the tree rotate are
of the same type.  In turn the result will be the same type and the
assignment into the designator (of the same set type) will succeed.

gcc/m2/ChangeLog:

	PR modula2/118998
	* gm2-gcc/m2expr.cc (m2expr_BuildLRotate): Convert nBits
	to the return type.
	(m2expr_BuildRRotate): Ditto.
	(m2expr_BuildLogicalRotate): Convert op3 to an integer type.
	Replace op3 aith rotateCount.
	Negate rotateCount if it is negative and call rotate right.
	* gm2-gcc/m2pp.cc (m2pp_bit_and_expr): New function.
	(m2pp_binary_function): Ditto.
	(m2pp_simple_expression): BIT_AND_EXPR new case clause.
	LROTATE_EXPR ditto.
	RROTATE_EXPR ditto.

gcc/testsuite/ChangeLog:

	PR modula2/118998
	* gm2/iso/pass/testrotate.mod: New test.
	* gm2/pim/fail/tinyconst.mod: New test.
	* gm2/sets/run/pass/simplepacked.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

2 files changed, 39 insertions, 6 deletions

diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc
index 7c2a6f1..8370959 100644
--- a/gcc/m2/gm2-gcc/m2expr.cc
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -673,6 +673,7 @@ m2expr_BuildLRotate (location_t location, tree op1, tree nBits,
 
   op1 = m2expr_FoldAndStrip (op1);
   nBits = m2expr_FoldAndStrip (nBits);
+  nBits = m2convert_BuildConvert (location, TREE_TYPE (op1), nBits, needconvert);  
   t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, nBits, needconvert);
   return m2expr_FoldAndStrip (t);
 }
@@ -688,6 +689,7 @@ m2expr_BuildRRotate (location_t location, tree op1, tree nBits,
 
   op1 = m2expr_FoldAndStrip (op1);
   nBits = m2expr_FoldAndStrip (nBits);
+  nBits = m2convert_BuildConvert (location, TREE_TYPE (op1), nBits, needconvert);
   t = m2expr_build_binary_op (location, RROTATE_EXPR, op1, nBits, needconvert);
   return m2expr_FoldAndStrip (t);
 }
@@ -801,18 +803,17 @@ m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2, tree op3,
     {
       char *labelElseName = createUniqueLabel ();
       char *labelEndName = createUniqueLabel ();
-      tree is_less = m2expr_BuildLessThan (location,
-                                           m2convert_ToInteger (location, op3),
+      tree rotateCount = m2convert_ToInteger (location, op3);
+      tree is_less = m2expr_BuildLessThan (location, rotateCount,
                                            m2expr_GetIntegerZero (location));
 
       m2statement_DoJump (location, is_less, NULL, labelElseName);
-      res = m2expr_BuildLRLn (location, op2, op3, nBits, needconvert);
+      res = m2expr_BuildLRLn (location, op2, rotateCount, nBits, needconvert);
       m2statement_BuildAssignmentTree (location, op1, res);
       m2statement_BuildGoto (location, labelEndName);
       m2statement_DeclareLabel (location, labelElseName);
-      res = m2expr_BuildLRRn (location, op2,
-                              m2expr_BuildNegate (location, op3, needconvert),
-                              nBits, needconvert);
+      rotateCount = m2expr_BuildNegate (location, rotateCount, needconvert);
+      res = m2expr_BuildLRRn (location, op2, rotateCount, nBits, needconvert);
       m2statement_BuildAssignmentTree (location, op1, res);
       m2statement_DeclareLabel (location, labelEndName);
     }
diff --git a/gcc/m2/gm2-gcc/m2pp.cc b/gcc/m2/gm2-gcc/m2pp.cc
index 0f6d35a..d7f5a41 100644
--- a/gcc/m2/gm2-gcc/m2pp.cc
+++ b/gcc/m2/gm2-gcc/m2pp.cc
@@ -1922,6 +1922,14 @@ m2pp_bit_ior_expr (pretty *s, tree t)
   m2pp_binary (s, t, "|");
 }
 
+/* m2pp_bit_and_expr generate a C style bit and.  */
+
+static void
+m2pp_bit_and_expr (pretty *s, tree t)
+{
+  m2pp_binary (s, t, "&");
+}
+
 /* m2pp_truth_expr.  */
 
 static void
@@ -1938,6 +1946,21 @@ m2pp_truth_expr (pretty *s, tree t, const char *op)
   m2pp_print (s, ")");
 }
 
+/* m2pp_binary_function handle GCC expression tree as a function.  */
+
+static void
+m2pp_binary_function (pretty *s, tree t, const char *funcname)
+{
+  m2pp_print (s, funcname);
+  m2pp_needspace (s);
+  m2pp_print (s, "(");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, ",");
+  m2pp_needspace (s);
+  m2pp_expression (s, TREE_OPERAND (t, 1));
+  m2pp_print (s, ")");
+}
+
 /* m2pp_simple_expression handle GCC expression tree.  */
 
 static void
@@ -2085,12 +2108,21 @@ m2pp_simple_expression (pretty *s, tree t)
     case BIT_IOR_EXPR:
       m2pp_bit_ior_expr (s, t);
       break;
+    case BIT_AND_EXPR:
+      m2pp_bit_and_expr (s, t);
+      break;
     case TRUTH_ANDIF_EXPR:
       m2pp_truth_expr (s, t, "AND");
       break;
     case TRUTH_ORIF_EXPR:
       m2pp_truth_expr (s, t, "OR");
       break;
+    case LROTATE_EXPR:
+      m2pp_binary_function (s, t, "LROTATE");
+      break;
+    case RROTATE_EXPR:
+      m2pp_binary_function (s, t, "RROTATE");      
+      break;
     default:
       m2pp_unknown (s, __FUNCTION__, get_tree_code_name (code));
     }