1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1997-2000, Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with CStand; use CStand;
30 with Einfo; use Einfo;
32 with Stand; use Stand;
33 with Targparm; use Targparm;
34 with Ttypef; use Ttypef;
35 with Uintp; use Uintp;
37 pragma Elaborate_All (Uintp);
39 package body Sem_VFpt is
41 T_Digits : constant Uint := UI_From_Int (IEEEL_Digits);
42 -- Digits for IEEE formats
48 procedure Set_D_Float (E : Entity_Id) is
50 Init_Size (Base_Type (E), 64);
51 Init_Alignment (Base_Type (E));
52 Init_Digits_Value (Base_Type (E), VAXDF_Digits);
53 Set_Vax_Float (Base_Type (E), True);
54 Set_Float_Bounds (Base_Type (E));
58 Init_Digits_Value (E, VAXDF_Digits);
59 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
66 procedure Set_F_Float (E : Entity_Id) is
68 Init_Size (Base_Type (E), 32);
69 Init_Alignment (Base_Type (E));
70 Init_Digits_Value (Base_Type (E), VAXFF_Digits);
71 Set_Vax_Float (Base_Type (E), True);
72 Set_Float_Bounds (Base_Type (E));
76 Init_Digits_Value (E, VAXFF_Digits);
77 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
84 procedure Set_G_Float (E : Entity_Id) is
86 Init_Size (Base_Type (E), 64);
87 Init_Alignment (Base_Type (E));
88 Init_Digits_Value (Base_Type (E), VAXGF_Digits);
89 Set_Vax_Float (Base_Type (E), True);
90 Set_Float_Bounds (Base_Type (E));
94 Init_Digits_Value (E, VAXGF_Digits);
95 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
102 procedure Set_IEEE_Long (E : Entity_Id) is
104 Init_Size (Base_Type (E), 64);
105 Init_Alignment (Base_Type (E));
106 Init_Digits_Value (Base_Type (E), IEEEL_Digits);
107 Set_Vax_Float (Base_Type (E), False);
108 Set_Float_Bounds (Base_Type (E));
112 Init_Digits_Value (E, IEEEL_Digits);
113 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
120 procedure Set_IEEE_Short (E : Entity_Id) is
122 Init_Size (Base_Type (E), 32);
123 Init_Alignment (Base_Type (E));
124 Init_Digits_Value (Base_Type (E), IEEES_Digits);
125 Set_Vax_Float (Base_Type (E), False);
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;