1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1997-2010, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with CStand
; use CStand
;
27 with Einfo
; use Einfo
;
29 with Stand
; use Stand
;
30 with Targparm
; use Targparm
;
32 package body Sem_VFpt
is
38 procedure Set_D_Float
(E
: Entity_Id
) is
39 VAXDF_Digits
: constant := 9;
42 Init_Size
(Base_Type
(E
), 64);
43 Init_Alignment
(Base_Type
(E
));
44 Init_Digits_Value
(Base_Type
(E
), VAXDF_Digits
);
45 Set_Float_Rep
(Base_Type
(E
), VAX_Native
);
46 Set_Float_Bounds
(Base_Type
(E
));
50 Init_Digits_Value
(E
, VAXDF_Digits
);
51 Set_Scalar_Range
(E
, Scalar_Range
(Base_Type
(E
)));
58 procedure Set_F_Float
(E
: Entity_Id
) is
59 VAXFF_Digits
: constant := 6;
62 Init_Size
(Base_Type
(E
), 32);
63 Init_Alignment
(Base_Type
(E
));
64 Init_Digits_Value
(Base_Type
(E
), VAXFF_Digits
);
65 Set_Float_Rep
(Base_Type
(E
), VAX_Native
);
66 Set_Float_Bounds
(Base_Type
(E
));
70 Init_Digits_Value
(E
, VAXFF_Digits
);
71 Set_Scalar_Range
(E
, Scalar_Range
(Base_Type
(E
)));
78 procedure Set_G_Float
(E
: Entity_Id
) is
79 VAXGF_Digits
: constant := 15;
82 Init_Size
(Base_Type
(E
), 64);
83 Init_Alignment
(Base_Type
(E
));
84 Init_Digits_Value
(Base_Type
(E
), VAXGF_Digits
);
85 Set_Float_Rep
(Base_Type
(E
), VAX_Native
);
86 Set_Float_Bounds
(Base_Type
(E
));
90 Init_Digits_Value
(E
, VAXGF_Digits
);
91 Set_Scalar_Range
(E
, Scalar_Range
(Base_Type
(E
)));
98 procedure Set_IEEE_Long
(E
: Entity_Id
) is
99 IEEEL_Digits
: constant := 15;
102 Init_Size
(Base_Type
(E
), 64);
103 Init_Alignment
(Base_Type
(E
));
104 Init_Digits_Value
(Base_Type
(E
), IEEEL_Digits
);
105 Set_Float_Rep
(Base_Type
(E
), IEEE_Binary
);
106 Set_Float_Bounds
(Base_Type
(E
));
110 Init_Digits_Value
(E
, IEEEL_Digits
);
111 Set_Scalar_Range
(E
, Scalar_Range
(Base_Type
(E
)));
118 procedure Set_IEEE_Short
(E
: Entity_Id
) is
119 IEEES_Digits
: constant := 6;
122 Init_Size
(Base_Type
(E
), 32);
123 Init_Alignment
(Base_Type
(E
));
124 Init_Digits_Value
(Base_Type
(E
), IEEES_Digits
);
125 Set_Float_Rep
(Base_Type
(E
), IEEE_Binary
);
126 Set_Float_Bounds
(Base_Type
(E
));
130 Init_Digits_Value
(E
, IEEES_Digits
);
131 Set_Scalar_Range
(E
, Scalar_Range
(Base_Type
(E
)));
134 ------------------------------
135 -- Set_Standard_Fpt_Formats --
136 ------------------------------
138 procedure Set_Standard_Fpt_Formats
is
142 if Opt
.Float_Format
= 'I' then
143 Set_IEEE_Short
(Standard_Float
);
144 Set_IEEE_Long
(Standard_Long_Float
);
145 Set_IEEE_Long
(Standard_Long_Long_Float
);
150 Set_F_Float
(Standard_Float
);
152 if Opt
.Float_Format_Long
= 'D' then
153 Set_D_Float
(Standard_Long_Float
);
155 Set_G_Float
(Standard_Long_Float
);
158 -- Note: Long_Long_Float gets set only in the real VMS case,
159 -- because this gives better results for testing out the use
160 -- of VAX float on non-VMS environments with the -gnatdm switch.
162 if OpenVMS_On_Target
then
163 Set_G_Float
(Standard_Long_Long_Float
);
166 end Set_Standard_Fpt_Formats
;