Implement -mmemcpy-strategy= and -mmemset-strategy= options
[official-gcc.git] / gcc / ada / sem_vfpt.adb
blob5ea780a39bef34ea0b052c781e08d65189abb3ed
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S E M _ V F P T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1997-2010, Free Software Foundation, Inc. --
10 -- --
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. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 with CStand; use CStand;
27 with Einfo; use Einfo;
28 with Opt; use Opt;
29 with Stand; use Stand;
30 with Targparm; use Targparm;
32 package body Sem_VFpt is
34 -----------------
35 -- Set_D_Float --
36 -----------------
38 procedure Set_D_Float (E : Entity_Id) is
39 VAXDF_Digits : constant := 9;
41 begin
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));
48 Init_Size (E, 64);
49 Init_Alignment (E);
50 Init_Digits_Value (E, VAXDF_Digits);
51 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
52 end Set_D_Float;
54 -----------------
55 -- Set_F_Float --
56 -----------------
58 procedure Set_F_Float (E : Entity_Id) is
59 VAXFF_Digits : constant := 6;
61 begin
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));
68 Init_Size (E, 32);
69 Init_Alignment (E);
70 Init_Digits_Value (E, VAXFF_Digits);
71 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
72 end Set_F_Float;
74 -----------------
75 -- Set_G_Float --
76 -----------------
78 procedure Set_G_Float (E : Entity_Id) is
79 VAXGF_Digits : constant := 15;
81 begin
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));
88 Init_Size (E, 64);
89 Init_Alignment (E);
90 Init_Digits_Value (E, VAXGF_Digits);
91 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
92 end Set_G_Float;
94 -------------------
95 -- Set_IEEE_Long --
96 -------------------
98 procedure Set_IEEE_Long (E : Entity_Id) is
99 IEEEL_Digits : constant := 15;
101 begin
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));
108 Init_Size (E, 64);
109 Init_Alignment (E);
110 Init_Digits_Value (E, IEEEL_Digits);
111 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
112 end Set_IEEE_Long;
114 --------------------
115 -- Set_IEEE_Short --
116 --------------------
118 procedure Set_IEEE_Short (E : Entity_Id) is
119 IEEES_Digits : constant := 6;
121 begin
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));
128 Init_Size (E, 32);
129 Init_Alignment (E);
130 Init_Digits_Value (E, IEEES_Digits);
131 Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
132 end Set_IEEE_Short;
134 ------------------------------
135 -- Set_Standard_Fpt_Formats --
136 ------------------------------
138 procedure Set_Standard_Fpt_Formats is
139 begin
140 -- IEEE case
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);
147 -- Vax float case
149 else
150 Set_F_Float (Standard_Float);
152 if Opt.Float_Format_Long = 'D' then
153 Set_D_Float (Standard_Long_Float);
154 else
155 Set_G_Float (Standard_Long_Float);
156 end if;
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);
164 end if;
165 end if;
166 end Set_Standard_Fpt_Formats;
168 end Sem_VFpt;