This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Fix wrong code with wide boolean type


Representation clauses make it possible to change the representation of many 
objects in Ada, thus breaking the uniformity of objects of a given type.  The 
compiler needs to compensate by inserting fixup code, e.g. at call points.

The problem at hand is that the fixup code is omitted for wide integer types, 
e.g. wide boolean types, when they are forced to be passed by reference.  The 
attached patch just plugs this hole.

Tested on x86_64-suse-linux, applied on the mainline.


2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (make_type_from_size) <INTEGER_TYPE>: Just copy
	TYPE_NAME.
	* gcc-interface/trans.c (smaller_packable_type_p): Rename into...
	(smaller_form_type_p): ...this.  Change parameter and variable names.
	(call_to_gnu): Use the nominal type of the parameter to create the
	temporary if it's a smaller form of the actual type.
	(addressable_p): Return false if the actual type is integral and its
	size is greater than that of the expected type.


2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/wide_boolean.adb: New test.
	* gnat.dg/wide_boolean_pkg.ad[sb]: New helper.


-- 
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 158390)
+++ gcc-interface/decl.c	(working copy)
@@ -7748,14 +7748,9 @@ make_type_from_size (tree type, tree siz
       SET_TYPE_RM_MAX_VALUE (new_type,
 			     convert (TREE_TYPE (new_type),
 				      TYPE_MAX_VALUE (type)));
-      /* Propagate the name to avoid creating a fake subrange type.  */
-      if (TYPE_NAME (type))
-	{
-	  if (TREE_CODE (TYPE_NAME (type)) == TYPE_DECL)
-	    TYPE_NAME (new_type) = DECL_NAME (TYPE_NAME (type));
-	  else
-	    TYPE_NAME (new_type) = TYPE_NAME (type);
-	}
+      /* Copy the name to show that it's essentially the same type and
+	 not a subrange type.  */
+      TYPE_NAME (new_type) = TYPE_NAME (type);
       TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
       SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
       return new_type;
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 158390)
+++ gcc-interface/trans.c	(working copy)
@@ -207,7 +207,7 @@ static tree emit_check (tree, tree, int,
 static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
 static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
 static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
-static bool smaller_packable_type_p (tree, tree);
+static bool smaller_form_type_p (tree, tree);
 static bool addressable_p (tree, tree);
 static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
 static tree extract_values (tree, tree);
@@ -2639,17 +2639,21 @@ call_to_gnu (Node_Id gnat_node, tree *gn
 		      (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))
 	    gnu_orig = gnu_name = TREE_OPERAND (gnu_name, 0);
 
-	  /* Otherwise convert to the nominal type of the object if it's
-	     a record type.  There are several cases in which we need to
-	     make the temporary using this type instead of the actual type
-	     of the object if they are distinct, because the expectations
-	     of the callee would otherwise not be met:
+	  /* Otherwise convert to the nominal type of the object if needed.
+	     There are several cases in which we need to make the temporary
+	     using this type instead of the actual type of the object when
+	     they are distinct, because the expectations of the callee would
+	     otherwise not be met:
 	       - if it's a justified modular type,
-	       - if the actual type is a smaller packable version of it.  */
-	  else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
-		   && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
-		       || smaller_packable_type_p (TREE_TYPE (gnu_name),
-						   gnu_name_type)))
+	       - if the actual type is a smaller form of it,
+	       - if it's a smaller form of the actual type.  */
+	  else if ((TREE_CODE (gnu_name_type) == RECORD_TYPE
+		    && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
+		        || smaller_form_type_p (TREE_TYPE (gnu_name),
+					        gnu_name_type)))
+		   || (INTEGRAL_TYPE_P (gnu_name_type)
+		       && smaller_form_type_p (gnu_name_type,
+					       TREE_TYPE (gnu_name))))
 	    gnu_name = convert (gnu_name_type, gnu_name);
 
 	  /* Create an explicit temporary holding the copy.  This ensures that
@@ -6873,28 +6877,28 @@ convert_with_check (Entity_Id gnat_type,
   return convert (gnu_type, gnu_result);
 }
 
-/* Return true if TYPE is a smaller packable version of RECORD_TYPE.  */
+/* Return true if TYPE is a smaller form of ORIG_TYPE.  */
 
 static bool
-smaller_packable_type_p (tree type, tree record_type)
+smaller_form_type_p (tree type, tree orig_type)
 {
-  tree size, rsize;
+  tree size, osize;
 
   /* We're not interested in variants here.  */
-  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (record_type))
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (orig_type))
     return false;
 
   /* Like a variant, a packable version keeps the original TYPE_NAME.  */
-  if (TYPE_NAME (type) != TYPE_NAME (record_type))
+  if (TYPE_NAME (type) != TYPE_NAME (orig_type))
     return false;
 
   size = TYPE_SIZE (type);
-  rsize = TYPE_SIZE (record_type);
+  osize = TYPE_SIZE (orig_type);
 
-  if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (rsize) == INTEGER_CST))
+  if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (osize) == INTEGER_CST))
     return false;
 
-  return tree_int_cst_lt (size, rsize) != 0;
+  return tree_int_cst_lt (size, osize) != 0;
 }
 
 /* Return true if GNU_EXPR can be directly addressed.  This is the case
@@ -6959,13 +6963,21 @@ smaller_packable_type_p (tree type, tree
 static bool
 addressable_p (tree gnu_expr, tree gnu_type)
 {
-  /* The size of the real type of the object must not be smaller than
-     that of the expected type, otherwise an indirect access in the
-     latter type would be larger than the object.  Only records need
-     to be considered in practice.  */
+  /* For an integral type, the size of the actual type of the object may not
+     be greater than that of the expected type, otherwise an indirect access
+     in the latter type wouldn't correctly set all the bits of the object.  */
+  if (gnu_type
+      && INTEGRAL_TYPE_P (gnu_type)
+      && smaller_form_type_p (gnu_type, TREE_TYPE (gnu_expr)))
+    return false;
+
+  /* The size of the actual type of the object may not be smaller than that
+     of the expected type, otherwise an indirect access in the latter type
+     would be larger than the object.  But only record types need to be
+     considered in practice for this case.  */
   if (gnu_type
       && TREE_CODE (gnu_type) == RECORD_TYPE
-      && smaller_packable_type_p (TREE_TYPE (gnu_expr), gnu_type))
+      && smaller_form_type_p (TREE_TYPE (gnu_expr), gnu_type))
     return false;
 
   switch (TREE_CODE (gnu_expr))
-- { dg-do run }

with Wide_Boolean_Pkg; use Wide_Boolean_Pkg;

procedure Wide_Boolean is

   R : TREC;
   LB_TEST_BOOL : TBOOL;

begin

   R.B := FALSE;
   LB_TEST_BOOL := FALSE;

   Modify (R.H, R.B);
   if (R.B /= TRUE) then
     raise Program_Error;
   end if;

   Modify (R.H, LB_TEST_BOOL);
   R.B := LB_TEST_BOOL;
   if (R.B /= TRUE) then
     raise Program_Error;
   end if;

end;
package body Wide_Boolean_Pkg is

   procedure Modify (LH : in out TUINT32; LB : in out TBOOL) is
   begin
      LH := 16#12345678#;
      LB := TRUE;
   end;

end Wide_Boolean_Pkg;
package Wide_Boolean_Pkg is

   type TBOOL is new BOOLEAN;
   for  TBOOL use (FALSE => 0, TRUE => 1);
   for  TBOOL'SIZE use 8;

   type TUINT32 is mod (2 ** 32);
   for  TUINT32'SIZE use 32;

   type TREC is
      record
         H : TUINT32;
         B : TBOOL;
      end record;
   for TREC use
      record
         H at 0 range 0..31;
         B at 4 range 0..31;
      end record;

   procedure Modify (LH : in out TUINT32; LB : in out TBOOL);
   pragma export(C, Modify, "Modify");

end Wide_Boolean_Pkg;

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]