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;
41 Init_Size (Base_Type (E), 64);
42 Init_Alignment (Base_Type (E));
43 Init_Digits_Value (Base_Type (E), VAXDF_Digits);
44 Set_Float_Rep (Base_Type (E), VAX_Native);
45 Set_Float_Bounds (Base_Type (E));
49 Init_Digits_Value (E, VAXDF_Digits);
50 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
57 procedure Set_F_Float (E : Entity_Id) is
58 VAXFF_Digits : constant := 6;
60 Init_Size (Base_Type (E), 32);
61 Init_Alignment (Base_Type (E));
62 Init_Digits_Value (Base_Type (E), VAXFF_Digits);
63 Set_Float_Rep (Base_Type (E), VAX_Native);
64 Set_Float_Bounds (Base_Type (E));
68 Init_Digits_Value (E, VAXFF_Digits);
69 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
76 procedure Set_G_Float (E : Entity_Id) is
77 VAXGF_Digits : constant := 15;
79 Init_Size (Base_Type (E), 64);
80 Init_Alignment (Base_Type (E));
81 Init_Digits_Value (Base_Type (E), VAXGF_Digits);
82 Set_Float_Rep (Base_Type (E), VAX_Native);
83 Set_Float_Bounds (Base_Type (E));
87 Init_Digits_Value (E, VAXGF_Digits);
88 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
95 procedure Set_IEEE_Long (E : Entity_Id) is
96 IEEEL_Digits : constant := 15;
98 Init_Size (Base_Type (E), 64);
99 Init_Alignment (Base_Type (E));
100 Init_Digits_Value (Base_Type (E), IEEEL_Digits);
101 Set_Float_Rep (Base_Type (E), IEEE_Binary);
102 Set_Float_Bounds (Base_Type (E));
106 Init_Digits_Value (E, IEEEL_Digits);
107 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
114 procedure Set_IEEE_Short (E : Entity_Id) is
115 IEEES_Digits : constant := 6;
117 Init_Size (Base_Type (E), 32);
118 Init_Alignment (Base_Type (E));
119 Init_Digits_Value (Base_Type (E), IEEES_Digits);
120 Set_Float_Rep (Base_Type (E), IEEE_Binary);
121 Set_Float_Bounds (Base_Type (E));
125 Init_Digits_Value (E, IEEES_Digits);
126 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
129 ------------------------------
130 -- Set_Standard_Fpt_Formats --
131 ------------------------------
133 procedure Set_Standard_Fpt_Formats is
137 if Opt.Float_Format = 'I' then
138 Set_IEEE_Short (Standard_Float);
139 Set_IEEE_Long (Standard_Long_Float);
140 Set_IEEE_Long (Standard_Long_Long_Float);
145 Set_F_Float (Standard_Float);
147 if Opt.Float_Format_Long = 'D' then
148 Set_D_Float (Standard_Long_Float);
150 Set_G_Float (Standard_Long_Float);
153 -- Note: Long_Long_Float gets set only in the real VMS case,
154 -- because this gives better results for testing out the use
155 -- of VAX float on non-VMS environments with the -gnatdm switch.
157 if OpenVMS_On_Target then
158 Set_G_Float (Standard_Long_Long_Float);
161 end Set_Standard_Fpt_Formats;