+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,
-- 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
Cons : List_Id;
begin
+
-- Nothing else to do if no change of representation
if Same_Representation (Operand_Type, Target_Type) then
-- 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,
-- 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
-- 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
-- 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
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,
-- 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 --
-- 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.
-- 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.
-- 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 --
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.
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 ..
OSDN Git Service
