Build_Float_Type
(To, UI_To_Int (Digits_Value (From)), Float_Rep (From),
UI_To_Int (Esize (From)), UI_To_Int (Alignment (From)));
+ Set_Is_IEEE_Extended_Precision (To, Is_IEEE_Extended_Precision (From));
end Copy_Float_Type;
----------------------
Size : Positive;
Alignment : Natural)
is
- pragma Unreferenced (Precision);
- -- See Build_Float_Type for the rationale
-
Ent : constant Entity_Id := New_Standard_Entity (Name);
+ IEEE_Extended_Precision_Size : constant := 80;
begin
Set_Defining_Identifier (New_Node (N_Full_Type_Declaration, Stloc), Ent);
Set_Scope (Ent, Standard_Standard);
Build_Float_Type
(Ent, Pos (Digs), Float_Rep, Int (Size), Nat (Alignment / 8));
+ -- We mostly disregard Precision, see Build_Float_Type for the
+ -- rationale. The only thing we use it for is to detect 80-bit IEEE
+ -- extended precision, in order to adjust the behavior of 'Write.
+ if Precision = IEEE_Extended_Precision_Size then
+ Set_Is_IEEE_Extended_Precision (Ent);
+ end if;
+
Append_New_Elmt (Ent, Back_End_Float_Types);
end Register_Float_Type;
-- a wrapper to handle inherited class-wide pre/post conditions that call
-- overridden primitives or as a wrapper of a controlling function.
+-- Is_IEEE_Extended_Precision
+-- Defined in floating point types and subtypes. Indicates that the type
+-- corresponds to the 80-bit IEEE extended precision format. That format
+-- effectively uses 80 bits per value, but we set its Size to a larger
+-- value for the reasons explained in the documentation comment of
+-- Build_Float_Type. We also perform some extra work to consistently set
+-- the extra bits to zero in the 'Write implementation, which is why we
+-- need this flag.
+
-- Itype_Printed
-- Defined in all type and subtype entities. Set in Itypes if the Itype
-- has been printed by Sprint. This is used to avoid printing an Itype
-- Digits_Value
-- Float_Rep (Float_Rep_Kind)
-- Default_Aspect_Value (base type only)
+ -- Is_IEEE_Extended_Precision
-- Scalar_Range
-- Static_Real_Or_String_Predicate
-- Machine_Emax_Value (synth)
then
return Prims (RE_I_LF, RE_W_LF);
+ elsif Is_IEEE_Extended_Precision (U_Type) then
+ -- For 80-bit IEEE extended precision values, we use a special
+ -- write routine that sets the unused bytes to zero. The reason
+ -- why we don't set Stream_Size to 80 and stream only the
+ -- meaningful bits is that the user is allowed to select the XDR
+ -- implementation of streaming at bind time, and XDR does not
+ -- allow 80 bits floating point values.
+ return Prims (RE_I_LLF, RE_W_80IEEE);
elsif P_Size = Standard_Long_Long_Float_Size then
return Prims (RE_I_LLF, RE_W_LLF);
else
Is_Volatile_Object,
Is_Volatile_Full_Access,
Is_Wrapper,
+ Is_IEEE_Extended_Precision,
Itype_Printed,
Kill_Elaboration_Checks,
Known_To_Have_Preelab_Init,
-- first named subtype).
Ab (Float_Kind, Real_Kind,
- (Sm (Digits_Value, Upos)));
+ (Sm (Digits_Value, Upos),
+ Sm (Is_IEEE_Extended_Precision, Flag)));
Cc (E_Floating_Point_Type, Float_Kind);
-- Floating point type, used for the anonymous base type of the
return "Is_Elaboration_Warnings_OK_Id";
when Is_Elaboration_Warnings_OK_Node =>
return "Is_Elaboration_Warnings_OK_Node";
+ when Is_IEEE_Extended_Precision =>
+ return "Is_IEEE_Extended_Precision";
when Is_Known_Guaranteed_ABE =>
return "Is_Known_Guaranteed_ABE";
when Is_RACW_Stub_Type =>
Ada.Streams.Write (Stream.all, From_WWC (Item));
end W_WWC;
+ N_IEEE_Extended_Precision_Bytes : constant := 10;
+
+ procedure W_80IEEE (Stream : not null access RST; Item : Long_Long_Float) is
+ begin
+ if XDR_Support then
+ XDR.W_LLF (Stream, Item);
+ return;
+ end if;
+
+ declare
+ X : S_LLF := From_LLF (Item);
+ begin
+ X (N_IEEE_Extended_Precision_Bytes + 1 .. X'Last) := (others => 0);
+ Ada.Streams.Write (Stream.all, X);
+ end;
+ end W_80IEEE;
+
end System.Stream_Attributes;
procedure W_WC (Stream : not null access RST; Item : Wide_Character);
procedure W_WWC (Stream : not null access RST; Item : Wide_Wide_Character);
+ procedure W_80IEEE (Stream : not null access RST; Item : Long_Long_Float);
+
function Block_IO_OK return Boolean;
-- Indicate whether the current setting supports block IO. See
-- System.Strings.Stream_Ops (s-ststop) for details on block IO.
RE_W_U24, -- System.Stream_Attributes
RE_W_WC, -- System.Stream_Attributes
RE_W_WWC, -- System.Stream_Attributes
+ RE_W_80IEEE, -- System.Stream_Attributes
RE_Storage_Array_Input, -- System.Strings.Stream_Ops
RE_Storage_Array_Input_Blk_IO, -- System.Strings.Stream_Ops
RE_W_U24 => System_Stream_Attributes,
RE_W_WC => System_Stream_Attributes,
RE_W_WWC => System_Stream_Attributes,
+ RE_W_80IEEE => System_Stream_Attributes,
RE_Storage_Array_Input => System_Strings_Stream_Ops,
RE_Storage_Array_Input_Blk_IO => System_Strings_Stream_Ops,
Set_Scalar_Range (Id, Scalar_Range (T));
Set_Digits_Value (Id, Digits_Value (T));
Set_Is_Constrained (Id, Is_Constrained (T));
+ Set_Is_IEEE_Extended_Precision
+ (Id, Is_IEEE_Extended_Precision (T));
-- If the floating point type has dimensions, these will be
-- inherited subsequently when Analyze_Dimensions is called.
Set_Digits_Value (Implicit_Base, Digits_Value (Parent_Base));
Set_Float_Rep (Implicit_Base, Float_Rep (Parent_Base));
+ Set_Is_IEEE_Extended_Precision
+ (Implicit_Base, Is_IEEE_Extended_Precision (Parent_Base));
if No_Constraint then
Set_Digits_Value (Derived_Type, Digits_Value (Parent_Type));
end if;
+ Set_Is_IEEE_Extended_Precision
+ (Derived_Type, Is_IEEE_Extended_Precision (Parent_Base));
elsif Is_Fixed_Point_Type (Parent_Type) then
return "Is_Elaboration_Checks_OK_Id";
when F_Is_Elaboration_Warnings_OK_Id =>
return "Is_Elaboration_Warnings_OK_Id";
+ when F_Is_IEEE_Extended_Precision =>
+ return "Is_IEEE_Extended_Precision";
when F_Is_RACW_Stub_Type =>
return "Is_RACW_Stub_Type";
when F_LSP_Subprogram =>
projects / thirdparty / gcc.git / commitdiff
