Skip to content

R
riscv-gcc-1
Commit 23c799b1 by Geert Bosch Committed by Arnaud Charlet
Options

cstand.adb (Build_Float_Type): Set Float_Rep according to platform. 

2010-10-22  Geert Bosch  <bosch@adacore.com>

	* cstand.adb (Build_Float_Type): Set Float_Rep according to platform.
	* einfo.ads (Float_Rep): New attribute.
	(Float_Rep_Kind): Move from body. Add comments.
	* einfo.adb (Float_Rep_Kind): Move to spec
	(Float_Rep): Now a real field instead of local function.
	(Set_Float_Rep): New procedure to set floating point representation
	(Set_Vax_Float): Remove.
	(Write_Entity_Flags): Remove Vax_Float flag.
	(Write_Field10_Name): Add E_Floating_Point_Type case for Float_Rep.
	* exp_attr.adb (Attribute_Valid): Use case statement for representation
	specific processing.
	* sem_ch3.adb (Build_Derived_Numeric_Type,
	Floating_Point_Type_Declaration): Set Float_Rep instead of Vax_Float
	attribute.
	* sem_util.ads, sem_util.adb (Is_AAMP_Float): Remove.
	* sem_vfpt.adb (Set_D_Float, Set_F_Float, Set_G_Float, Set_IEEE_Long,
	Set_IEEE_Short): Set Float_Rep instead of Vax_Float attribute.

From-SVN: r165816
parent b4ca2d2c
Showing with 114 additions and 111 deletions
gcc/ada/ChangeLog
2010-10-22 Geert Bosch <bosch@adacore.com>
* cstand.adb (Build_Float_Type): Set Float_Rep according to platform.
* einfo.ads (Float_Rep): New attribute.
(Float_Rep_Kind): Move from body. Add comments.
* einfo.adb (Float_Rep_Kind): Move to spec
(Float_Rep): Now a real field instead of local function.
(Set_Float_Rep): New procedure to set floating point representation
(Set_Vax_Float): Remove.
(Write_Entity_Flags): Remove Vax_Float flag.
(Write_Field10_Name): Add E_Floating_Point_Type case for Float_Rep.
* exp_attr.adb (Attribute_Valid): Use case statement for representation
specific processing.
* sem_ch3.adb (Build_Derived_Numeric_Type,
Floating_Point_Type_Declaration): Set Float_Rep instead of Vax_Float
attribute.
* sem_util.ads, sem_util.adb (Is_AAMP_Float): Remove.
* sem_vfpt.adb (Set_D_Float, Set_F_Float, Set_G_Float, Set_IEEE_Long,
Set_IEEE_Short): Set Float_Rep instead of Vax_Float attribute.
2010-10-22 Robert Dewar <dewar@adacore.com>
* sprint.adb: Minor reformatting.
......
gcc/ada/cstand.adb
......@@ -140,8 +140,17 @@ package body CStand is
Set_Type_Definition (Parent (E),
Make_Floating_Point_Definition (Stloc,
Digits_Expression => Make_Integer (UI_From_Int (Digs))));
Set_Ekind (E, E_Floating_Point_Type);
Set_Etype (E, E);
if AAMP_On_Target then
Set_Float_Rep (E, AAMP);
else
Set_Float_Rep (E, IEEE_Binary);
end if;
Init_Size (E, Siz);
Set_Elem_Alignment (E);
Init_Digits_Value (E, Digs);
......@@ -1874,9 +1883,9 @@ package body CStand is
begin
-- Note: for the call from Cstand to initially create the types in
-- Standard, Vax_Float will always be False. Circuitry in Sem_Vfpt
-- will adjust these types appropriately in the Vax_Float case if a
-- pragma Float_Representation (VAX_Float) is used.
-- Standard, Float_Rep will never be VAX_Native. Circuitry in Sem_Vfpt
-- will adjust these types appropriately VAX_Native if a pragma
-- Float_Representation (VAX_Float) is used.
H := Make_Float_Literal (Stloc, Radix, Significand, Exponent);
L := Make_Float_Literal (Stloc, Radix, -Significand, Exponent);
......
gcc/ada/einfo.adb
......@@ -37,7 +37,6 @@ with Nlists; use Nlists;
with Output; use Output;
with Sinfo; use Sinfo;
with Stand; use Stand;
with Targparm; use Targparm;
package body Einfo is
......@@ -88,6 +87,7 @@ package body Einfo is
-- Direct_Primitive_Operations Elist10
-- Discriminal_Link Node10
-- Float_Rep Uint10 (but returns Float_Rep_Kind)
-- Handler_Records List10
-- Normalized_Position_Max Uint10
......@@ -406,7 +406,7 @@ package body Einfo is
-- Is_Compilation_Unit Flag149
-- Has_Pragma_Elaborate_Body Flag150
-- Vax_Float Flag151
-- (unused) Flag151
-- Entry_Accepted Flag152
-- Is_Obsolescent Flag153
-- Has_Per_Object_Constraint Flag154
......@@ -521,12 +521,6 @@ package body Einfo is
-- (unused) Flag253
-- (unused) Flag254
-----------------
-- Local types --
-----------------
type Float_Rep_Kind is (IEEE_Binary, VAX_Native, AAMP);
-----------------------
-- Local subprograms --
-----------------------
......@@ -535,23 +529,14 @@ package body Einfo is
-- Returns the attribute definition clause for Id whose name is Rep_Name.
-- Returns Empty if no matching attribute definition clause found for Id.
function Float_Rep (Id : E) return Float_Rep_Kind;
-- Returns the floating point representation used for the given type
---------------
-- Float_Rep --
---------------
function Float_Rep (Id : E) return Float_Rep_Kind is
function Float_Rep (Id : E) return F is
pragma Assert (Is_Floating_Point_Type (Id));
begin
if AAMP_On_Target then
return AAMP;
elsif Vax_Float (Id) then
return VAX_Native;
else
return IEEE_Binary;
end if;
return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));
end Float_Rep;
----------------
......@@ -2873,7 +2858,7 @@ package body Einfo is
function Vax_Float (Id : E) return B is
begin
return Flag151 (Base_Type (Id));
return Is_Floating_Point_Type (Id) and then Float_Rep (Id) = VAX_Native;
end Vax_Float;
function Warnings_Off (Id : E) return B is
......@@ -3685,6 +3670,12 @@ package body Einfo is
Set_Node6 (Id, V);
end Set_First_Rep_Item;
procedure Set_Float_Rep (Id : E; V : F) is
pragma Assert (Ekind (Id) = E_Floating_Point_Type);
begin
Set_Uint10 (Id, UI_From_Int (F'Pos (V)));
end Set_Float_Rep;
procedure Set_Freeze_Node (Id : E; V : N) is
begin
Set_Node7 (Id, V);
......@@ -5375,12 +5366,6 @@ package body Einfo is
Set_Flag222 (Id, V);
end Set_Used_As_Generic_Actual;
procedure Set_Vax_Float (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
Set_Flag151 (Id, V);
end Set_Vax_Float;
procedure Set_Warnings_Off (Id : E; V : B := True) is
begin
Set_Flag96 (Id, V);
......@@ -7499,7 +7484,6 @@ package body Einfo is
W ("Universal_Aliasing", Flag216 (Id));
W ("Used_As_Generic_Actual", Flag222 (Id));
W ("Uses_Sec_Stack", Flag95 (Id));
W ("Vax_Float", Flag151 (Id));
W ("Warnings_Off", Flag96 (Id));
W ("Warnings_Off_Used", Flag236 (Id));
W ("Warnings_Off_Used_Unmodified", Flag237 (Id));
......@@ -7735,6 +7719,9 @@ package body Einfo is
Concurrent_Kind =>
Write_Str ("Direct_Primitive_Operations");
when Float_Kind =>
Write_Str ("Float_Rep");
when E_In_Parameter |
E_Constant =>
Write_Str ("Discriminal_Link");
......
gcc/ada/einfo.ads
......@@ -1264,6 +1264,11 @@ package Einfo is
-- Note in particular that size clauses are present only for this
-- purpose, and should only be accessed if Has_Size_Clause is set.
-- Float_Rep (Uint8)
-- Present in floating-point entities. Contains a value of type
-- Float_Rep_Kind. Together with the Digits_Value uniquely defines
-- the floating-point representation to be used.
-- Freeze_Node (Node7)
-- Present in all entities. If there is an associated freeze node for
-- the entity, this field references this freeze node. If no freeze
......@@ -3786,11 +3791,6 @@ package Einfo is
-- entries). Set to True when secondary stack is used in this scope and
-- must be released on exit unless Sec_Stack_Needed_For_Return is set.
-- Vax_Float (Flag151) [base type only]
-- Present in all type and subtype entities. Set only on the base type of
-- float types with Vax format. The particular format is determined by
-- the Digits_Value value which is 6,9,15 for F_Float, D_Float, G_Float.
-- Warnings_Off (Flag96)
-- Present in all entities. Set if a pragma Warnings (Off, entity-name)
-- is used to suppress warnings for a given entity. It is also used by
......@@ -5094,6 +5094,7 @@ package Einfo is
-- E_Floating_Point_Type
-- E_Floating_Point_Subtype
-- Digits_Value (Uint17)
-- Float_Rep (Uint8) (Float_Rep_Kind)
-- Machine_Emax_Value (synth)
-- Machine_Emin_Value (synth)
-- Machine_Mantissa_Value (synth)
......@@ -5108,6 +5109,7 @@ package Einfo is
-- Scalar_Range (Node20)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- Vax_Float (synth)
-- (plus type attributes)
-- E_Function
......@@ -5669,6 +5671,15 @@ package Einfo is
Calign_Component_Size_4, -- natural for size <= 4, 4 for size >= 4
Calign_Storage_Unit); -- all components byte aligned
----------------------------------
-- Floating Point Repesentation --
----------------------------------
type Float_Rep_Kind is (
IEEE_Binary, -- IEEE 754p conform binary format
VAX_Native, -- VAX D, F, G or H format
AAMP); -- AAMP format
---------------
-- Iterators --
---------------
......@@ -5848,6 +5859,7 @@ package Einfo is
subtype B is Boolean;
subtype C is Component_Alignment_Kind;
subtype E is Entity_Id;
subtype F is Float_Rep_Kind;
subtype M is Mechanism_Type;
subtype N is Node_Id;
subtype U is Uint;
......@@ -5953,6 +5965,7 @@ package Einfo is
function First_Optional_Parameter (Id : E) return E;
function First_Private_Entity (Id : E) return E;
function First_Rep_Item (Id : E) return N;
function Float_Rep (Id : E) return F;
function Freeze_Node (Id : E) return N;
function From_With_Type (Id : E) return B;
function Full_View (Id : E) return E;
......@@ -6532,6 +6545,7 @@ package Einfo is
procedure Set_First_Optional_Parameter (Id : E; V : E);
procedure Set_First_Private_Entity (Id : E; V : E);
procedure Set_First_Rep_Item (Id : E; V : N);
procedure Set_Float_Rep (Id : E; V : F);
procedure Set_Freeze_Node (Id : E; V : N);
procedure Set_From_With_Type (Id : E; V : B := True);
procedure Set_Full_View (Id : E; V : E);
......@@ -6825,7 +6839,6 @@ package Einfo is
procedure Set_Unset_Reference (Id : E; V : N);
procedure Set_Used_As_Generic_Actual (Id : E; V : B := True);
procedure Set_Uses_Sec_Stack (Id : E; V : B := True);
procedure Set_Vax_Float (Id : E; V : B := True);
procedure Set_Warnings_Off (Id : E; V : B := True);
procedure Set_Warnings_Off_Used (Id : E; V : B := True);
procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True);
......@@ -7558,7 +7571,6 @@ package Einfo is
pragma Inline (Unset_Reference);
pragma Inline (Used_As_Generic_Actual);
pragma Inline (Uses_Sec_Stack);
pragma Inline (Vax_Float);
pragma Inline (Warnings_Off);
pragma Inline (Warnings_Off_Used);
pragma Inline (Warnings_Off_Used_Unmodified);
......@@ -7952,7 +7964,6 @@ package Einfo is
pragma Inline (Set_Unset_Reference);
pragma Inline (Set_Used_As_Generic_Actual);
pragma Inline (Set_Uses_Sec_Stack);
pragma Inline (Set_Vax_Float);
pragma Inline (Set_Warnings_Off);
pragma Inline (Set_Warnings_Off_Used);
pragma Inline (Set_Warnings_Off_Used_Unmodified);
......
gcc/ada/exp_attr.adb
......@@ -4771,53 +4771,54 @@ package body Exp_Attr is
Ftp : Entity_Id;
begin
-- For vax fpt types, call appropriate routine in special vax
-- floating point unit. We do not have to worry about loads in
-- this case, since these types have no signalling NaN's.
if Vax_Float (Btyp) then
Expand_Vax_Valid (N);
case Float_Rep (Btyp) is
-- For vax fpt types, call appropriate routine in special
-- vax floating point unit. We do not have to worry about
-- loads in this case, since these types have no signalling
-- NaN's.
-- The AAMP back end handles Valid for floating-point types
when VAX_Native => Expand_Vax_Valid (N);
elsif Is_AAMP_Float (Btyp) then
Analyze_And_Resolve (Pref, Ptyp);
Set_Etype (N, Standard_Boolean);
Set_Analyzed (N);
-- The AAMP back end handles Valid for floating-point types
-- Non VAX float case
when AAMP =>
Analyze_And_Resolve (Pref, Ptyp);
Set_Etype (N, Standard_Boolean);
Set_Analyzed (N);
else
Find_Fat_Info (Ptyp, Ftp, Pkg);
-- If the floating-point object might be unaligned, we need
-- to call the special routine Unaligned_Valid, which makes
-- the needed copy, being careful not to load the value into
-- any floating-point register. The argument in this case is
-- obj'Address (see Unaligned_Valid routine in Fat_Gen).
if Is_Possibly_Unaligned_Object (Pref) then
Expand_Fpt_Attribute
(N, Pkg, Name_Unaligned_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Pref),
Attribute_Name => Name_Address)));
when IEEE_Binary =>
Find_Fat_Info (Ptyp, Ftp, Pkg);
-- In the normal case where we are sure the object is
-- aligned, we generate a call to Valid, and the argument in
-- this case is obj'Unrestricted_Access (after converting
-- obj to the right floating-point type).
-- If the floating-point object might be unaligned, we
-- need to call the special routine Unaligned_Valid,
-- which makes the needed copy, being careful not to
-- load the value into any floating-point register.
-- The argument in this case is obj'Address (see
-- Unaligned_Valid routine in Fat_Gen).
else
Expand_Fpt_Attribute
(N, Pkg, Name_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Unchecked_Convert_To (Ftp, Pref),
Attribute_Name => Name_Unrestricted_Access)));
end if;
end if;
if Is_Possibly_Unaligned_Object (Pref) then
Expand_Fpt_Attribute
(N, Pkg, Name_Unaligned_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Pref),
Attribute_Name => Name_Address)));
-- In the normal case where we are sure the object is
-- aligned, we generate a call to Valid, and the argument
-- in this case is obj'Unrestricted_Access (after
-- converting obj to the right floating-point type).
else
Expand_Fpt_Attribute
(N, Pkg, Name_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Unchecked_Convert_To (Ftp, Pref),
Attribute_Name => Name_Unrestricted_Access)));
end if;
end case;
-- One more task, we still need a range check. Required
-- only if we have a constraint, since the Valid routine
......@@ -5468,7 +5469,7 @@ package body Exp_Attr is
raise Program_Error;
end case;
-- If neither the base type nor the root type is VAX_Float then VAX
-- If neither the base type nor the root type is VAX_Native then VAX
-- float is out of the picture, and we can just use the root type.
else
......
gcc/ada/sem_ch3.adb
......@@ -5646,7 +5646,7 @@ package body Sem_Ch3 is
-- already have been set if there was a constraint present.
Set_Digits_Value (Implicit_Base, Digits_Value (Parent_Base));
Set_Vax_Float (Implicit_Base, Vax_Float (Parent_Base));
Set_Float_Rep (Implicit_Base, Float_Rep (Parent_Base));
if No_Constraint then
Set_Digits_Value (Derived_Type, Digits_Value (Parent_Type));
......@@ -14730,7 +14730,7 @@ package body Sem_Ch3 is
Set_RM_Size (Implicit_Base, RM_Size (Base_Typ));
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ));
Set_Digits_Value (Implicit_Base, Digits_Value (Base_Typ));
Set_Vax_Float (Implicit_Base, Vax_Float (Base_Typ));
Set_Float_Rep (Implicit_Base, Float_Rep (Base_Typ));
Set_Ekind (T, E_Floating_Point_Subtype);
Set_Etype (T, Implicit_Base);
......
gcc/ada/sem_util.adb
......@@ -5703,18 +5703,6 @@ package body Sem_Util is
end loop;
end Inspect_Deferred_Constant_Completion;
-------------------
-- Is_AAMP_Float --
-------------------
function Is_AAMP_Float (E : Entity_Id) return Boolean is
pragma Assert (Is_Type (E));
begin
return AAMP_On_Target
and then Is_Floating_Point_Type (E)
and then E = Base_Type (E);
end Is_AAMP_Float;
-----------------------------
-- Is_Actual_Out_Parameter --
-----------------------------
......
gcc/ada/sem_util.ads
......@@ -653,14 +653,6 @@ package Sem_Util is
-- whether they have been completed by a full constant declaration or an
-- Import pragma. Emit the error message if that is not the case.
function Is_AAMP_Float (E : Entity_Id) return Boolean;
-- Defined for all type entities. Returns True only for the base type of
-- float types with AAMP format. The particular format is determined by the
-- Digits_Value value which is 6 for the 32-bit floating point type, or 9
-- for the 48-bit type. This is not an attribute function (like VAX_Float)
-- in order to not use up an extra flag and to prevent the dependency of
-- Einfo on Targparm which would be required for a synthesized attribute.
function Is_Actual_Out_Parameter (N : Node_Id) return Boolean;
-- Determines if N is an actual parameter of out mode in a subprogram call
......
gcc/ada/sem_vfpt.adb
......@@ -37,12 +37,11 @@ package body Sem_VFpt is
procedure Set_D_Float (E : Entity_Id) is
VAXDF_Digits : constant := 9;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXDF_Digits);
Set_Vax_Float (Base_Type (E), True);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
......@@ -57,12 +56,11 @@ package body Sem_VFpt is
procedure Set_F_Float (E : Entity_Id) is
VAXFF_Digits : constant := 6;
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXFF_Digits);
Set_Vax_Float (Base_Type (E), True);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
......@@ -77,12 +75,11 @@ package body Sem_VFpt is
procedure Set_G_Float (E : Entity_Id) is
VAXGF_Digits : constant := 15;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXGF_Digits);
Set_Vax_Float (Base_Type (E), True);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
......@@ -97,12 +94,11 @@ package body Sem_VFpt is
procedure Set_IEEE_Long (E : Entity_Id) is
IEEEL_Digits : constant := 15;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), IEEEL_Digits);
Set_Vax_Float (Base_Type (E), False);
Set_Float_Rep (Base_Type (E), IEEE_Binary);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
......@@ -117,12 +113,11 @@ package body Sem_VFpt is
procedure Set_IEEE_Short (E : Entity_Id) is
IEEES_Digits : constant := 6;
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), IEEES_Digits);
Set_Vax_Float (Base_Type (E), False);
Set_Float_Rep (Base_Type (E), IEEE_Binary);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment