checks.adb (Apply_Arithmetic_Overflow_Check): Add comments cross-referencing the…

checks.adb (Apply_Arithmetic_Overflow_Check): Add comments cross-referencing the new related code in...

2009-07-23  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Apply_Arithmetic_Overflow_Check): Add comments
	cross-referencing the new related code in
	Exp_Ch4.Expand_N_Type_Conversion.
	* exp_ch4.adb (Expand_N_Type_Conversion): Avoid unnecessary overflows

	* exp_disp.adb, exp_disp.ads, sinfo.ads: Minor reformatting.
	Add comment.

From-SVN: r149983

gcc/ada/ChangeLog

+2009-07-23  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Apply_Arithmetic_Overflow_Check): Add comments
+	cross-referencing the new related code in
+	Exp_Ch4.Expand_N_Type_Conversion.
+	* exp_ch4.adb (Expand_N_Type_Conversion): Avoid unnecessary overflows
+
+	* exp_disp.adb, exp_disp.ads, sinfo.ads: Minor reformatting.
+	Add comment.
+
 2009-07-23  Javier Miranda  <miranda@adacore.com>
 
 	* sinfo.ads (Is_Scil_Node, Scil_Nkind, Scil_Related_Node,

gcc/ada/checks.adb

@@ -760,6 +760,13 @@ package body Checks is
       --  off, since this is precisely about giving the "right" result and
       --  avoiding the need for an overflow check.
 
+      --  Note: this circuit is partially redundant with respect to the similar
+      --  processing in Exp_Ch4.Expand_N_Type_Conversion, but the latter deals
+      --  with cases that do not come through here. We still need the following
+      --  processing even with the Exp_Ch4 code in place, since we want to be
+      --  sure not to generate the arithmetic overflow check in these cases
+      --  (Exp_Ch4 would have a hard time removing them once generated).
+
       if Is_Signed_Integer_Type (Typ)
         and then Nkind (Parent (N)) = N_Type_Conversion
       then

gcc/ada/exp_ch4.adb

@@ -7621,6 +7621,7 @@ package body Exp_Ch4 is
          Cons : List_Id;
 
       begin
+
          --  Nothing else to do if no change of representation
 
          if Same_Representation (Operand_Type, Target_Type) then
@@ -7860,8 +7861,7 @@ package body Exp_Ch4 is
          --  Otherwise rewrite the conversion as described above
 
          Conv := Relocate_Node (N);
-         Rewrite
-           (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc));
+         Rewrite (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc));
          Set_Etype (Conv, Btyp);
 
          --  Enable overflow except for case of integer to float conversions,
@@ -7937,6 +7937,94 @@ package body Exp_Ch4 is
 
       --  Here if we may need to expand conversion
 
+      --  If the operand of the type conversion is an arithmetic operation on
+      --  signed integers, and the based type of the signed integer type in
+      --  question is smaller than Standard.Integer, we promote both of the
+      --  operands to type Integer.
+
+      --  For example, if we have
+
+      --     target-type (opnd1 + opnd2)
+
+      --  and opnd1 and opnd2 are of type short integer, then we rewrite
+      --  this as:
+
+      --     target-type (integer(opnd1) + integer(opnd2))
+
+      --  We do this because we are always allowed to compute in a larger type
+      --  if we do the right thing with the result, and in this case we are
+      --  going to do a conversion which will do an appropriate check to make
+      --  sure that things are in range of the target type in any case. This
+      --  avoids some unnecessary intermediate overflows.
+
+      --  We also do a similar transformation in the case where the target
+      --  type is a 64-bit signed integer, in this case we do the inner
+      --  computation in Long_Long_Integer. We also use Long_Long_Integer
+      --  as the inner type in the fixed-point or floating-point target case.
+
+      --  Note: this circuit is partially redundant with respect to the circuit
+      --  in Checks.Apply_Arithmetic_Overflow_Check, but we catch more cases in
+      --  the processing here. Also we still need the Checks circuit, since we
+      --  have to be sure not to generate junk overflow checks in the first
+      --  place, since it would be trick to remove them here!
+
+      declare
+         Inner_Type        : Entity_Id          := Empty;
+         Root_Target_Type  : constant Entity_Id := Root_Type (Target_Type);
+         Root_Operand_Type : constant Entity_Id := Root_Type (Operand_Type);
+
+      begin
+         if (Root_Target_Type = Base_Type (Standard_Long_Long_Integer)
+              or else Is_Real_Type (Root_Target_Type))
+           and then Is_Signed_Integer_Type (Operand_Type)
+         then
+            Inner_Type := Standard_Long_Long_Integer;
+
+         elsif Root_Operand_Type = Base_Type (Standard_Short_Integer)
+                 or else
+               Root_Operand_Type = Base_Type (Standard_Short_Short_Integer)
+         then
+            Inner_Type := Standard_Integer;
+         end if;
+
+         --  Do rewrite if enabled
+
+         if Present (Inner_Type) then
+
+            --  Test for binary operation. Note that this includes junk like
+            --  XOR and concatenation, but none of those will yield a signed
+            --  integer result, so we won't get here except in the interesting
+            --  cases of simple arithmetic operators like addition.
+
+            if Nkind (Operand) in N_Binary_Op then
+               Rewrite (Left_Opnd (Operand),
+                 Make_Type_Conversion (Loc,
+                   Subtype_Mark => New_Reference_To (Inner_Type, Loc),
+                   Expression   => Relocate_Node (Left_Opnd (Operand))));
+
+               Rewrite (Right_Opnd (Operand),
+                 Make_Type_Conversion (Loc,
+                   Subtype_Mark => New_Reference_To (Inner_Type, Loc),
+                   Expression   => Relocate_Node (Right_Opnd (Operand))));
+
+               Set_Analyzed (Operand, False);
+               Analyze_And_Resolve (Operand, Inner_Type);
+
+               --  Similar processing for unary operation. The only interesting
+               --  case is negation, nothing else can produce an overflow.
+
+            elsif Nkind (Operand) = N_Op_Minus then
+               Rewrite (Right_Opnd (Operand),
+                 Make_Type_Conversion (Loc,
+                   Subtype_Mark => New_Reference_To (Inner_Type, Loc),
+                   Expression   => Relocate_Node (Right_Opnd (Operand))));
+
+               Set_Analyzed (Operand, False);
+               Analyze_And_Resolve (Operand, Inner_Type);
+            end if;
+         end if;
+      end;
+
       --  Do validity check if validity checking operands
 
       if Validity_Checks_On
@@ -9596,9 +9684,7 @@ package body Exp_Ch4 is
       --  Skip this processing if the component size is different from system
       --  storage unit (since at least for NOT this would cause problems).
 
-      if Is_Array_Type (Etype (Lhs))
-        and then Component_Size (Etype (Lhs)) /= System_Storage_Unit
-      then
+      if Component_Size (Etype (Lhs)) /= System_Storage_Unit then
          return False;
 
       --  Cannot do in place stuff on VM_Target since cannot pass addresses
@@ -9608,9 +9694,7 @@ package body Exp_Ch4 is
 
       --  Cannot do in place stuff if non-standard Boolean representation
 
-      elsif (Is_Array_Type (Etype (Lhs)) or else Is_String_Type (Etype (Lhs)))
-        and then Has_Non_Standard_Rep (Component_Type (Etype (Lhs)))
-      then
+      elsif Has_Non_Standard_Rep (Component_Type (Etype (Lhs))) then
          return False;
 
       elsif not Is_Unaliased (Lhs) then

gcc/ada/exp_disp.adb

@@ -643,7 +643,7 @@ package body Exp_Disp is
          Typ := Non_Limited_View (Typ);
       end if;
 
-      --  Generate the SCIL node of this dispatching call
+      --  Generate the SCIL node for this dispatching call
 
       if Generate_SCIL then
          Insert_Action (Call_Node,

gcc/ada/exp_disp.ads

@@ -39,26 +39,24 @@ package Exp_Disp is
    --  N_Null_Statement nodes that have extra attributes. The information
    --  available through these extra attributes relies on the kind of SCIL
    --  node. The SCIL node kind is stored in the Scil_Nkind attribute of
-   --  the N_Null_Statement node. The kind of SCIL nodes generated by the
-   --  frontend are the following:
-
-   --    IP_Tag_Init: Scil node of tag component initialization.
-
-   --    Dispatching_Call: Scil node of dispatching call. Used by the
-   --      CodePeer backend to locate nodes associated with dispatching
-   --      calls.
-
-   --    Dispatching_Table_Object_Init: Scil node of object declaration
-   --      containing a dispatch table.
-
-   --    Dispatching_Table_Tag_Init: Scil node of tag initialization.
+   --  the N_Null_Statement node, and indicates the type of the SCIL node.
 
    type Scil_Node_Kind is
      (Unused,
+      --  What is this for ???
+
       IP_Tag_Init,
+      --  SCIL node for tag component initialization
+
       Dispatching_Call,
+      --  SCIL node for dispatching call. Used by the CodePeer backend to
+      --  locate nodes associated with dispatching calls.
+
       Dispatch_Table_Object_Init,
+      --  SCIL node for object declaration containing a dispatch table
+
       Dispatch_Table_Tag_Init);
+      --  SCIL node for tag initialization
 
    -------------------------------------
    -- Predefined primitive operations --

gcc/ada/sinfo.ads

@@ -1253,10 +1253,10 @@ package Sinfo is
 
    --  Is_Scil_Node (Flag4-Sem)
    --    Present in N_Null_Statement nodes. Set to indicate that it is a SCIL
-   --    node. Scil nodes are special nodes that help the CodePeer backend
+   --    node. SCIL nodes are special nodes that help the CodePeer backend
    --    locating nodes that require special processing. In order to minimize
    --    the impact on the compiler and ASIS, and also to maximize flexibility
-   --    when adding SCIl nodes to the tree, instead of adding new kind of
+   --    when adding SCIL nodes to the tree, instead of adding new kind of
    --    nodes, SCIL nodes are added to the tree as N_Null_Statement nodes on
    --    which this attribute is set.
 
@@ -1599,11 +1599,11 @@ package Sinfo is
    --    and multiplication operations.
 
    --  Scil_Nkind (Uint3-Sem)
-   --    Present in N_Null_Statement nodes that are Scil nodes. Used to
-   --    indicate the kind of SCIL node (see scil node kinds in exp_disp.ads).
+   --    Present in N_Null_Statement nodes that are SCIL nodes. Indicates the
+   --    kind of SCIL node (see Scil_Node_Kind in Exp_Disp spec).
 
    --  Scil_Related_Node (Node1-Sem)
-   --    Present in N_Null_Statement nodes that are Scil nodes. Used to
+   --    Present in N_Null_Statement nodes that are SCIL nodes. Used to
    --    reference a tree node that requires special processing in the
    --    CodePeer backend.
 
@@ -3866,7 +3866,11 @@ package Sinfo is
 
       --  Note that in SCIL nodes (N_Null_Statement nodes with Is_Scil_Node
       --  set to True), Entity references the tagged type associated with
-      --  the SCIL node.
+      --  the SCIL node. However, this is not really an Entity field in the
+      --  normal sense, so N_Null_Statement is not included in N_Has_Entity.
+
+      --  It would be much better to call this SCIL_Entity, and avoid this
+      --  very confusing non-standard use of Entity. ???
 
       ----------------
       -- 5.1  Label --
@@ -7430,9 +7434,9 @@ package Sinfo is
      N_Attribute_Reference;
    --  Nodes that have Entity fields
    --  Warning: DOES NOT INCLUDE N_Freeze_Entity!
-
+   --
    --  Warning: DOES NOT INCLUDE N_Null_Assignment because it not always
-   --  available. The Entity attribute is only available in Scil nodes
+   --  available. The Entity attribute is only available in SCIL nodes
    --  (that is, N_Null_Assignment nodes that have Is_Scil_Node set to true).
    --  Processing such nodes never requires testing if the node is in
    --  N_Has_Entity node kind.
@@ -7452,14 +7456,13 @@ package Sinfo is
    subtype N_Later_Decl_Item is Node_Kind range
      N_Task_Type_Declaration ..
      N_Generic_Subprogram_Declaration;
-   --  Note: this is Ada 83 relevant only (see Ada 83 RM 3.9 (2)) and
-   --  includes only those items which can appear as later declarative
-   --  items. This also includes N_Implicit_Label_Declaration which is
-   --  not specifically in the grammar but may appear as a valid later
-   --  declarative items. It does NOT include N_Pragma which can also
-   --  appear among later declarative items. It does however include
-   --  N_Protected_Body, which is a bit peculiar, but harmless since
-   --  this cannot appear in Ada 83 mode anyway.
+   --  Note: this is Ada 83 relevant only (see Ada 83 RM 3.9 (2)) and includes
+   --  only those items which can appear as later declarative items. This also
+   --  includes N_Implicit_Label_Declaration which is not specifically in the
+   --  grammar but may appear as a valid later declarative items. It does NOT
+   --  include N_Pragma which can also appear among later declarative items.
+   --  It does however include N_Protected_Body, which is a bit peculiar, but
+   --  harmless since this cannot appear in Ada 83 mode anyway.
 
    subtype N_Membership_Test is Node_Kind range
       N_In ..