From eaa826f822541a6059d1f633b4299a81079c160b Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 23 Jul 2009 09:34:26 +0000 Subject: [PATCH] checks.adb (Apply_Arithmetic_Overflow_Check): Add comments cross-referencing the new related code in... 2009-07-23 Robert Dewar * 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 | 10 +++++ gcc/ada/checks.adb | 7 +++ gcc/ada/exp_ch4.adb | 100 +++++++++++++++++++++++++++++++++++++++---- gcc/ada/exp_disp.adb | 2 +- gcc/ada/exp_disp.ads | 24 +++++------ gcc/ada/sinfo.ads | 35 ++++++++------- 6 files changed, 140 insertions(+), 38 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8a119acc165..05a6cc89c8d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2009-07-23 Robert Dewar + + * 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 * sinfo.ads (Is_Scil_Node, Scil_Nkind, Scil_Related_Node, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index e3bf4b32287..e39e3e079a6 100644 --- a/gcc/ada/checks.adb +++ b/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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 456f46f607c..c55cfa54050 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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 diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 104b1c013de..191b88f1639 100644 --- a/gcc/ada/exp_disp.adb +++ b/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, diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index e02cca76995..fa16aaf0ffb 100644 --- a/gcc/ada/exp_disp.ads +++ b/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 -- diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 9d42a510be2..e1ab8f0026c 100644 --- a/gcc/ada/sinfo.ads +++ b/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 ..