if Is_Fixed_Point_Type (Typ) then
- -- No special processing if Treat_Fixed_As_Integer is set, since
- -- from a semantic point of view such operations are simply integer
- -- operations and will be treated that way.
-
- if not Treat_Fixed_As_Integer (N) then
- if Is_Integer_Type (Rtyp) then
- Expand_Divide_Fixed_By_Integer_Giving_Fixed (N);
- else
- Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N);
- end if;
+ if Is_Integer_Type (Rtyp) then
+ Expand_Divide_Fixed_By_Integer_Giving_Fixed (N);
+ else
+ Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N);
end if;
-- Deal with divide-by-zero check if back end cannot handle them
Reason => CE_Divide_By_Zero));
end if;
- -- Other cases of division of fixed-point operands. Again we exclude the
- -- case where Treat_Fixed_As_Integer is set.
+ -- Other cases of division of fixed-point operands
- elsif (Is_Fixed_Point_Type (Ltyp) or else Is_Fixed_Point_Type (Rtyp))
- and then not Treat_Fixed_As_Integer (N)
- then
+ elsif Is_Fixed_Point_Type (Ltyp) or else Is_Fixed_Point_Type (Rtyp) then
if Is_Integer_Type (Typ) then
Expand_Divide_Fixed_By_Fixed_Giving_Integer (N);
else
if Is_Fixed_Point_Type (Typ) then
- -- No special processing if Treat_Fixed_As_Integer is set, since from
- -- a semantic point of view such operations are simply integer
- -- operations and will be treated that way.
-
- if not Treat_Fixed_As_Integer (N) then
+ -- Case of fixed * integer => fixed
- -- Case of fixed * integer => fixed
+ if Is_Integer_Type (Rtyp) then
+ Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N);
- if Is_Integer_Type (Rtyp) then
- Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N);
+ -- Case of integer * fixed => fixed
- -- Case of integer * fixed => fixed
+ elsif Is_Integer_Type (Ltyp) then
+ Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N);
- elsif Is_Integer_Type (Ltyp) then
- Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N);
+ -- Case of fixed * fixed => fixed
- -- Case of fixed * fixed => fixed
-
- else
- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N);
- end if;
+ else
+ Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N);
end if;
- -- Other cases of multiplication of fixed-point operands. Again we
- -- exclude the cases where Treat_Fixed_As_Integer flag is set.
+ -- Other cases of multiplication of fixed-point operands
- elsif (Is_Fixed_Point_Type (Ltyp) or else Is_Fixed_Point_Type (Rtyp))
- and then not Treat_Fixed_As_Integer (N)
- then
+ elsif Is_Fixed_Point_Type (Ltyp) or else Is_Fixed_Point_Type (Rtyp) then
if Is_Integer_Type (Typ) then
Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N);
else
-- set the Etype values correctly. In addition, setting the Etype ensures
-- that the analyzer does not try to redetermine the type when the node
-- is analyzed (which would be wrong, since in the case where we set the
- -- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
- -- still dealing with a normal fixed-point operation and mess it up).
+ -- Conversion_OK flag, it would think it was still dealing with a normal
+ -- fixed-point operation and mess it up).
function Build_Conversion
(N : Node_Id;
-- expressions, using the source location from Sloc (N). The operands are
-- either both Universal_Real, in which case Build_Divide differs from
-- Make_Op_Divide only in that the Etype of the resulting node is set (to
- -- Universal_Real), or they can be integer types. In this case the integer
- -- types need not be the same, and Build_Divide converts the operand with
- -- the smaller sized type to match the type of the other operand and sets
- -- this as the result type. The Rounded_Result flag of the result in this
- -- case is set from the Rounded_Result flag of node N. On return, the
- -- resulting node is analyzed, and has its Etype set.
+ -- Universal_Real), or they can be integer or fixed-point types. In this
+ -- case the types need not be the same, and Build_Divide chooses a type
+ -- long enough to hold both operands (i.e. the size of the longer of the
+ -- two operand types), and both operands are converted to this type. The
+ -- Etype of the result is also set to this value. The Rounded_Result flag
+ -- of the result in this case is set from the Rounded_Result flag of node
+ -- N. On return, the resulting node is analyzed and has its Etype set.
function Build_Double_Divide
(N : Node_Id;
-- expressions, using the source location from Sloc (N). The operands are
-- either both Universal_Real, in which case Build_Multiply differs from
-- Make_Op_Multiply only in that the Etype of the resulting node is set (to
- -- Universal_Real), or they can be integer types. In this case the integer
- -- types need not be the same, and Build_Multiply chooses a type long
- -- enough to hold the product (i.e. twice the size of the longer of the two
- -- operand types), and both operands are converted to this type. The Etype
- -- of the result is also set to this value. However, the result can never
- -- overflow Integer_64, so this is the largest type that is ever generated.
- -- On return, the resulting node is analyzed and has its Etype set.
+ -- Universal_Real), or they can be integer or fixed-point types. In this
+ -- case the types need not be the same, and Build_Multiply chooses a type
+ -- long enough to hold the product (i.e. twice the size of the longer of
+ -- the two operand types), and both operands are converted to this type.
+ -- The Etype of the result is also set to this value. However, the result
+ -- can never overflow Integer_64, so this is the largest type that is ever
+ -- generated. On return, the resulting node is analyzed and has Etype set.
function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
-- Builds an N_Op_Rem node from the given left and right operand
Loc : constant Source_Ptr := Sloc (N);
Left_Type : constant Entity_Id := Base_Type (Etype (L));
Right_Type : constant Entity_Id := Base_Type (Etype (R));
+ Left_Size : Int;
+ Right_Size : Int;
+ Rsize : Int;
Result_Type : Entity_Id;
Rnode : Node_Id;
return L;
end if;
- -- If left and right types are the same, no conversion needed
+ -- First figure out the effective sizes of the operands. Normally
+ -- the effective size of an operand is the RM_Size of the operand.
+ -- But a special case arises with operands whose size is known at
+ -- compile time. In this case, we can use the actual value of the
+ -- operand to get its size if it would fit signed in 8 or 16 bits.
+
+ Left_Size := UI_To_Int (RM_Size (Left_Type));
+
+ if Compile_Time_Known_Value (L) then
+ declare
+ Val : constant Uint := Expr_Value (L);
+ begin
+ if Val < Int'(2 ** 7) then
+ Left_Size := 8;
+ elsif Val < Int'(2 ** 15) then
+ Left_Size := 16;
+ end if;
+ end;
+ end if;
+
+ Right_Size := UI_To_Int (RM_Size (Right_Type));
+
+ if Compile_Time_Known_Value (R) then
+ declare
+ Val : constant Uint := Expr_Value (R);
+ begin
+ if Val <= Int'(2 ** 7) then
+ Right_Size := 8;
+ elsif Val <= Int'(2 ** 15) then
+ Right_Size := 16;
+ end if;
+ end;
+ end if;
+
+ -- Do the operation using the longer of the two sizes
- if Left_Type = Right_Type then
- Result_Type := Left_Type;
- Rnode :=
- Make_Op_Divide (Loc,
- Left_Opnd => L,
- Right_Opnd => R);
+ Rsize := Int'Max (Left_Size, Right_Size);
- -- Use left type if it is the larger of the two
+ if Rsize <= 8 then
+ Result_Type := Standard_Integer_8;
- elsif Esize (Left_Type) >= Esize (Right_Type) then
- Result_Type := Left_Type;
- Rnode :=
- Make_Op_Divide (Loc,
- Left_Opnd => L,
- Right_Opnd => Build_Conversion (N, Left_Type, R));
+ elsif Rsize <= 16 then
+ Result_Type := Standard_Integer_16;
- -- Otherwise right type is larger of the two, us it
+ elsif Rsize <= 32 then
+ Result_Type := Standard_Integer_32;
else
- Result_Type := Right_Type;
- Rnode :=
- Make_Op_Divide (Loc,
- Left_Opnd => Build_Conversion (N, Right_Type, L),
- Right_Opnd => R);
+ Result_Type := Standard_Integer_64;
end if;
+
+ Rnode :=
+ Make_Op_Divide (Loc,
+ Left_Opnd => Build_Conversion (N, Result_Type, L),
+ Right_Opnd => Build_Conversion (N, Result_Type, R));
end if;
-- We now have a divide node built with Result_Type set. First
Set_Etype (Rnode, Base_Type (Result_Type));
- -- Set Treat_Fixed_As_Integer if operation on fixed-point type
- -- since this is a literal arithmetic operation, to be performed
- -- by Gigi without any consideration of small values.
-
- if Is_Fixed_Point_Type (Result_Type) then
- Set_Treat_Fixed_As_Integer (Rnode);
- end if;
-
-- The result is rounded if the target of the operation is decimal
-- and Rounded_Result is set, or if the target of the operation
-- is an integer type.
Set_Rounded_Result (Rnode);
end if;
+ -- One more check. We did the divide operation using the longer of
+ -- the two sizes, which is reasonable. However, in the case where the
+ -- two types have unequal sizes, it is impossible for the result of
+ -- a divide operation to be larger than the dividend, so we can put
+ -- a conversion round the result to keep the evolving operation size
+ -- as small as possible.
+
+ if not Is_Floating_Point_Type (Left_Type) then
+ Rnode := Build_Conversion (N, Left_Type, Rnode);
+ end if;
+
return Rnode;
end Build_Divide;
Set_Etype (Rnode, Base_Type (Result_Type));
- -- Set Treat_Fixed_As_Integer if operation on fixed-point type
- -- since this is a literal arithmetic operation, to be performed
- -- by Gigi without any consideration of small values.
-
- if Is_Fixed_Point_Type (Result_Type) then
- Set_Treat_Fixed_As_Integer (Rnode);
- end if;
-
return Rnode;
end Build_Multiply;
Set_Etype (Rnode, Base_Type (Result_Type));
- -- Set Treat_Fixed_As_Integer if operation on fixed-point type
- -- since this is a literal arithmetic operation, to be performed
- -- by Gigi without any consideration of small values.
-
- if Is_Fixed_Point_Type (Result_Type) then
- Set_Treat_Fixed_As_Integer (Rnode);
- end if;
-
-- One more check. We did the rem operation using the larger of the
-- two types, which is reasonable. However, in the case where the
-- two types have unequal sizes, it is impossible for the result of
-- We really need to set Analyzed here because we may be creating a
-- very strange beast, namely an integer literal typed as fixed-point
- -- and the analyzer won't like that. Probably we should allow the
- -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
- -- and teach the analyzer how to handle them ???
+ -- and the analyzer won't like that.
Set_Analyzed (L);
return L;
if Present (Op_Id) then
if Ekind (Op_Id) = E_Operator then
-
- if Nkind_In (N, N_Op_Divide, N_Op_Mod, N_Op_Multiply, N_Op_Rem)
- and then Treat_Fixed_As_Integer (N)
- then
- null;
- else
- Set_Etype (N, Any_Type);
- Find_Arithmetic_Types (L, R, Op_Id, N);
- end if;
-
+ Set_Etype (N, Any_Type);
+ Find_Arithmetic_Types (L, R, Op_Id, N);
else
Set_Etype (N, Any_Type);
Add_One_Interp (N, Op_Id, Etype (Op_Id));
if Is_Fixed_Point_Type (T1)
and then (Is_Fixed_Point_Type (T2) or else T2 = Universal_Real)
then
- -- If Treat_Fixed_As_Integer is set then the Etype is already set
- -- and no further processing is required (this is the case of an
- -- operator constructed by Exp_Fixd for a fixed point operation)
- -- Otherwise add one interpretation with universal fixed result
- -- If the operator is given in functional notation, it comes
- -- from source and Fixed_As_Integer cannot apply.
-
- if (Nkind (N) not in N_Op
- or else not Treat_Fixed_As_Integer (N))
- and then
- (not Has_Fixed_Op (T1, Op_Id)
- or else Nkind (Parent (N)) = N_Type_Conversion)
+ -- Add one interpretation with universal fixed result
+
+ if not Has_Fixed_Op (T1, Op_Id)
+ or else Nkind (Parent (N)) = N_Type_Conversion
then
Add_One_Interp (N, Op_Id, Universal_Fixed);
end if;
elsif Is_Fixed_Point_Type (T2)
- and then (Nkind (N) not in N_Op
- or else not Treat_Fixed_As_Integer (N))
and then T1 = Universal_Real
and then
(not Has_Fixed_Op (T1, Op_Id)
elsif Op_Name = Name_Op_Mod or else Op_Name = Name_Op_Rem then
- -- Note: The fixed-point operands case with Treat_Fixed_As_Integer
- -- set does not require any special processing, since the Etype is
- -- already set (case of operation constructed by Exp_Fixed).
-
if Is_Integer_Type (T1)
and then (Covers (T1 => T1, T2 => T2)
or else
return List2 (N);
end Then_Statements;
- function Treat_Fixed_As_Integer
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Op_Divide
- or else NT (N).Nkind = N_Op_Mod
- or else NT (N).Nkind = N_Op_Multiply
- or else NT (N).Nkind = N_Op_Rem);
- return Flag14 (N);
- end Treat_Fixed_As_Integer;
-
function Triggering_Alternative
(N : Node_Id) return Node_Id is
begin
Set_List2_With_Parent (N, Val);
end Set_Then_Statements;
- procedure Set_Treat_Fixed_As_Integer
- (N : Node_Id; Val : Boolean := True) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Op_Divide
- or else NT (N).Nkind = N_Op_Mod
- or else NT (N).Nkind = N_Op_Multiply
- or else NT (N).Nkind = N_Op_Rem);
- Set_Flag14 (N, Val);
- end Set_Treat_Fixed_As_Integer;
-
procedure Set_Triggering_Alternative
(N : Node_Id; Val : Node_Id) is
begin
-- need for this field, so in the tree passed to Gigi, this field is
-- always set to No_List.
- -- Treat_Fixed_As_Integer (Flag14-Sem)
- -- This flag appears in operator nodes for divide, multiply, mod, and rem
- -- on fixed-point operands. It indicates that the operands are to be
- -- treated as integer values, ignoring small values. This flag is only
- -- set as a result of expansion of fixed-point operations. Typically a
- -- fixed-point multiplication in the source generates subsidiary
- -- multiplication and division operations that work with the underlying
- -- integer values and have this flag set. Note that this flag is not
- -- needed on other arithmetic operations (add, neg, subtract etc.) since
- -- in these cases it is always the case that fixed is treated as integer.
- -- The Etype field MUST be set if this flag is set. The analyzer knows to
- -- leave such nodes alone, and whoever makes them must set the correct
- -- Etype value.
-
-- TSS_Elist (Elist3-Sem)
-- Present in N_Freeze_Entity nodes. Holds an element list containing
-- entries for each TSS (type support subprogram) associated with the
-- HIGHEST_PRECEDENCE_OPERATOR ::= ** | abs | not
- -- Sprint syntax if Treat_Fixed_As_Integer is set:
-
- -- x #* y
- -- x #/ y
- -- x #mod y
- -- x #rem y
-
- -- Gigi restriction: For * / mod rem with fixed-point operands, Gigi
- -- will only be given nodes with the Treat_Fixed_As_Integer flag set.
- -- All handling of smalls for multiplication and division is handled
- -- by the front end (mod and rem result only from expansion). Gigi
- -- thus never needs to worry about small values (for other operators
- -- operating on fixed-point, e.g. addition, the small value does not
- -- have any semantic effect anyway, these are always integer operations.
+ -- Gigi restriction: Gigi will never be given * / mod rem nodes with
+ -- fixed-point operands. All handling of smalls for multiplication and
+ -- division is handled by the front end (mod and rem result only from
+ -- expansion). Gigi thus never needs to worry about small values (for
+ -- other operators operating on fixed-point, e.g. addition, the small
+ -- value does not have any semantic effect anyway, these are always
+ -- integer operations.
-- Gigi restriction: For all operators taking Boolean operands, the
-- type is always Standard.Boolean. The expander inserts the required
-- N_Op_Multiply
-- Sloc points to *
- -- Treat_Fixed_As_Integer (Flag14-Sem)
-- Rounded_Result (Flag18-Sem)
-- plus fields for binary operator
-- plus fields for expression
-- N_Op_Divide
-- Sloc points to /
- -- Treat_Fixed_As_Integer (Flag14-Sem)
-- Do_Division_Check (Flag13-Sem)
-- Rounded_Result (Flag18-Sem)
-- plus fields for binary operator
-- N_Op_Mod
-- Sloc points to MOD
- -- Treat_Fixed_As_Integer (Flag14-Sem)
-- Do_Division_Check (Flag13-Sem)
-- plus fields for binary operator
-- plus fields for expression
-- N_Op_Rem
-- Sloc points to REM
- -- Treat_Fixed_As_Integer (Flag14-Sem)
-- Do_Division_Check (Flag13-Sem)
-- plus fields for binary operator
-- plus fields for expression
-- the semantics is to treat these simply as integer operations, with
-- the small values being ignored (the bounds are already stored in
-- units of small, so that constraint checking works as usual). For the
- -- case of multiply/divide/rem/mod operations, Gigi will only see fixed
- -- point operands if the Treat_Fixed_As_Integer flag is set and will
- -- thus treat these nodes in identical manner, ignoring small values.
+ -- case of multiply/divide/rem/mod operations, Gigi will never see them.
-- Note on equality/inequality tests for records. In the expanded tree,
-- record comparisons are always expanded to be a series of component
N_Op_Expon,
N_Op_Subtract,
- -- N_Binary_Op, N_Op, N_Subexpr, N_Has_Treat_Fixed_As_Integer
+ -- N_Binary_Op, N_Op, N_Subexpr,
-- N_Has_Etype, N_Has_Chars, N_Has_Entity, N_Multiplying_Operator
N_Op_Divide,
N_Error ..
N_Subtype_Indication;
- subtype N_Has_Treat_Fixed_As_Integer is Node_Kind range
- N_Op_Divide ..
- N_Op_Rem;
-
subtype N_Multiplying_Operator is Node_Kind range
N_Op_Divide ..
N_Op_Rem;
function Then_Statements
(N : Node_Id) return List_Id; -- List2
- function Treat_Fixed_As_Integer
- (N : Node_Id) return Boolean; -- Flag14
-
function Triggering_Alternative
(N : Node_Id) return Node_Id; -- Node1
procedure Set_Then_Statements
(N : Node_Id; Val : List_Id); -- List2
- procedure Set_Treat_Fixed_As_Integer
- (N : Node_Id; Val : Boolean := True); -- Flag14
-
procedure Set_Triggering_Alternative
(N : Node_Id; Val : Node_Id); -- Node1
pragma Inline (Then_Statements);
pragma Inline (Triggering_Alternative);
pragma Inline (Triggering_Statement);
- pragma Inline (Treat_Fixed_As_Integer);
pragma Inline (TSS_Elist);
pragma Inline (Type_Definition);
pragma Inline (Uneval_Old_Accept);
pragma Inline (Set_Task_Present);
pragma Inline (Set_Then_Actions);
pragma Inline (Set_Then_Statements);
- pragma Inline (Set_Treat_Fixed_As_Integer);
pragma Inline (Set_Triggering_Alternative);
pragma Inline (Set_Triggering_Statement);
pragma Inline (Set_Type_Definition);
-- Used to print output lines in Debug_Generated_Code mode (this is used
-- as the argument for a call to Set_Special_Output in package Output).
- procedure Process_TFAI_RR_Flags (Nod : Node_Id);
- -- Given a divide, multiplication or division node, check the flags
- -- Treat_Fixed_As_Integer and Rounded_Flags, and if set, output the
- -- appropriate special syntax characters (# and @).
-
procedure Set_Debug_Sloc;
-- If Dump_Node is non-empty, this routine sets the appropriate value
-- in its Sloc field, from the current location in the debug source file
Write_Debug_Line (S, Debug_Sloc);
end Print_Debug_Line;
- ---------------------------
- -- Process_TFAI_RR_Flags --
- ---------------------------
-
- procedure Process_TFAI_RR_Flags (Nod : Node_Id) is
- begin
- if Treat_Fixed_As_Integer (Nod) then
- Write_Char ('#');
- end if;
-
- if Rounded_Result (Nod) then
- Write_Char ('@');
- end if;
- end Process_TFAI_RR_Flags;
-
--------
-- ps --
--------
when N_Op_Divide =>
Sprint_Left_Opnd (Node);
Write_Char (' ');
- Process_TFAI_RR_Flags (Node);
+ if Rounded_Result (Node) then
+ Write_Char ('@');
+ end if;
Write_Operator (Node, "/ ");
Sprint_Right_Opnd (Node);
when N_Op_Mod =>
Sprint_Left_Opnd (Node);
-
- if Treat_Fixed_As_Integer (Node) then
- Write_Str (" #");
- end if;
-
Write_Operator (Node, " mod ");
Sprint_Right_Opnd (Node);
when N_Op_Multiply =>
Sprint_Left_Opnd (Node);
Write_Char (' ');
- Process_TFAI_RR_Flags (Node);
+ if Rounded_Result (Node) then
+ Write_Char ('@');
+ end if;
Write_Operator (Node, "* ");
Sprint_Right_Opnd (Node);
when N_Op_Rem =>
Sprint_Left_Opnd (Node);
-
- if Treat_Fixed_As_Integer (Node) then
- Write_Str (" #");
- end if;
-
Write_Operator (Node, " rem ");
Sprint_Right_Opnd (Node);
-- Convert wi Conversion_OK target?(source)
-- Convert wi Float_Truncate target^(source)
-- Convert wi Rounded_Result target@(source)
- -- Divide wi Treat_Fixed_As_Integer x #/ y
-- Divide wi Rounded_Result x @/ y
-- Expression with actions do action; .. action; in expr end
-- Expression with range check {expression}
-- Itype declaration [(sub)type declaration without ;]
-- Itype reference reference itype
-- Label declaration labelname : label
- -- Mod wi Treat_Fixed_As_Integer x #mod y
-- Multiple concatenation expr && expr && expr ... && expr
- -- Multiply wi Treat_Fixed_As_Integer x #* y
-- Multiply wi Rounded_Result x @* y
-- Operator with overflow check {operator} (e.g. {+})
-- Others choice for cleanup when all others
-- Raise xxx error [xxx_error [when cond]]
-- Raise xxx error with msg [xxx_error [when cond], "msg"]
-- Rational literal [expression]
- -- Rem wi Treat_Fixed_As_Integer x #rem y
-- Reference expression'reference
-- Shift nodes shift_name!(expr, count)
-- Static declaration name : static xxx
projects / thirdparty / gcc.git / commitdiff
