annotate gcc/ada/layout.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT COMPILER COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- L A Y O U T --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
9 -- Copyright (C) 2001-2019, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
kono
parents:
diff changeset
17 -- for more details. You should have received a copy of the GNU General --
kono
parents:
diff changeset
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
kono
parents:
diff changeset
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
kono
parents:
diff changeset
20 -- --
kono
parents:
diff changeset
21 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
23 -- --
kono
parents:
diff changeset
24 ------------------------------------------------------------------------------
kono
parents:
diff changeset
25
kono
parents:
diff changeset
26 with Atree; use Atree;
kono
parents:
diff changeset
27 with Debug; use Debug;
kono
parents:
diff changeset
28 with Einfo; use Einfo;
kono
parents:
diff changeset
29 with Errout; use Errout;
kono
parents:
diff changeset
30 with Opt; use Opt;
kono
parents:
diff changeset
31 with Sem_Aux; use Sem_Aux;
kono
parents:
diff changeset
32 with Sem_Ch13; use Sem_Ch13;
kono
parents:
diff changeset
33 with Sem_Eval; use Sem_Eval;
kono
parents:
diff changeset
34 with Sem_Util; use Sem_Util;
kono
parents:
diff changeset
35 with Sinfo; use Sinfo;
kono
parents:
diff changeset
36 with Snames; use Snames;
kono
parents:
diff changeset
37 with Ttypes; use Ttypes;
kono
parents:
diff changeset
38 with Uintp; use Uintp;
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 package body Layout is
kono
parents:
diff changeset
41
kono
parents:
diff changeset
42 ------------------------
kono
parents:
diff changeset
43 -- Local Declarations --
kono
parents:
diff changeset
44 ------------------------
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 SSU : constant Int := Ttypes.System_Storage_Unit;
kono
parents:
diff changeset
47 -- Short hand for System_Storage_Unit
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 -----------------------
kono
parents:
diff changeset
50 -- Local Subprograms --
kono
parents:
diff changeset
51 -----------------------
kono
parents:
diff changeset
52
kono
parents:
diff changeset
53 procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id);
kono
parents:
diff changeset
54 -- Given an array type or an array subtype E, compute whether its size
kono
parents:
diff changeset
55 -- depends on the value of one or more discriminants and set the flag
kono
parents:
diff changeset
56 -- Size_Depends_On_Discriminant accordingly. This need not be called
kono
parents:
diff changeset
57 -- in front end layout mode since it does the computation on its own.
kono
parents:
diff changeset
58
kono
parents:
diff changeset
59 procedure Set_Composite_Alignment (E : Entity_Id);
kono
parents:
diff changeset
60 -- This procedure is called for record types and subtypes, and also for
kono
parents:
diff changeset
61 -- atomic array types and subtypes. If no alignment is set, and the size
kono
parents:
diff changeset
62 -- is 2 or 4 (or 8 if the word size is 8), then the alignment is set to
kono
parents:
diff changeset
63 -- match the size.
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 ----------------------------
kono
parents:
diff changeset
66 -- Adjust_Esize_Alignment --
kono
parents:
diff changeset
67 ----------------------------
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69 procedure Adjust_Esize_Alignment (E : Entity_Id) is
kono
parents:
diff changeset
70 Abits : Int;
kono
parents:
diff changeset
71 Esize_Set : Boolean;
kono
parents:
diff changeset
72
kono
parents:
diff changeset
73 begin
kono
parents:
diff changeset
74 -- Nothing to do if size unknown
kono
parents:
diff changeset
75
kono
parents:
diff changeset
76 if Unknown_Esize (E) then
kono
parents:
diff changeset
77 return;
kono
parents:
diff changeset
78 end if;
kono
parents:
diff changeset
79
kono
parents:
diff changeset
80 -- Determine if size is constrained by an attribute definition clause
kono
parents:
diff changeset
81 -- which must be obeyed. If so, we cannot increase the size in this
kono
parents:
diff changeset
82 -- routine.
kono
parents:
diff changeset
83
kono
parents:
diff changeset
84 -- For a type, the issue is whether an object size clause has been set.
kono
parents:
diff changeset
85 -- A normal size clause constrains only the value size (RM_Size)
kono
parents:
diff changeset
86
kono
parents:
diff changeset
87 if Is_Type (E) then
kono
parents:
diff changeset
88 Esize_Set := Has_Object_Size_Clause (E);
kono
parents:
diff changeset
89
kono
parents:
diff changeset
90 -- For an object, the issue is whether a size clause is present
kono
parents:
diff changeset
91
kono
parents:
diff changeset
92 else
kono
parents:
diff changeset
93 Esize_Set := Has_Size_Clause (E);
kono
parents:
diff changeset
94 end if;
kono
parents:
diff changeset
95
kono
parents:
diff changeset
96 -- If size is known it must be a multiple of the storage unit size
kono
parents:
diff changeset
97
kono
parents:
diff changeset
98 if Esize (E) mod SSU /= 0 then
kono
parents:
diff changeset
99
kono
parents:
diff changeset
100 -- If not, and size specified, then give error
kono
parents:
diff changeset
101
kono
parents:
diff changeset
102 if Esize_Set then
kono
parents:
diff changeset
103 Error_Msg_NE
kono
parents:
diff changeset
104 ("size for& not a multiple of storage unit size",
kono
parents:
diff changeset
105 Size_Clause (E), E);
kono
parents:
diff changeset
106 return;
kono
parents:
diff changeset
107
kono
parents:
diff changeset
108 -- Otherwise bump up size to a storage unit boundary
kono
parents:
diff changeset
109
kono
parents:
diff changeset
110 else
kono
parents:
diff changeset
111 Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU);
kono
parents:
diff changeset
112 end if;
kono
parents:
diff changeset
113 end if;
kono
parents:
diff changeset
114
kono
parents:
diff changeset
115 -- Now we have the size set, it must be a multiple of the alignment
kono
parents:
diff changeset
116 -- nothing more we can do here if the alignment is unknown here.
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 if Unknown_Alignment (E) then
kono
parents:
diff changeset
119 return;
kono
parents:
diff changeset
120 end if;
kono
parents:
diff changeset
121
kono
parents:
diff changeset
122 -- At this point both the Esize and Alignment are known, so we need
kono
parents:
diff changeset
123 -- to make sure they are consistent.
kono
parents:
diff changeset
124
kono
parents:
diff changeset
125 Abits := UI_To_Int (Alignment (E)) * SSU;
kono
parents:
diff changeset
126
kono
parents:
diff changeset
127 if Esize (E) mod Abits = 0 then
kono
parents:
diff changeset
128 return;
kono
parents:
diff changeset
129 end if;
kono
parents:
diff changeset
130
kono
parents:
diff changeset
131 -- Here we have a situation where the Esize is not a multiple of the
kono
parents:
diff changeset
132 -- alignment. We must either increase Esize or reduce the alignment to
kono
parents:
diff changeset
133 -- correct this situation.
kono
parents:
diff changeset
134
kono
parents:
diff changeset
135 -- The case in which we can decrease the alignment is where the
kono
parents:
diff changeset
136 -- alignment was not set by an alignment clause, and the type in
kono
parents:
diff changeset
137 -- question is a discrete type, where it is definitely safe to reduce
kono
parents:
diff changeset
138 -- the alignment. For example:
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140 -- t : integer range 1 .. 2;
kono
parents:
diff changeset
141 -- for t'size use 8;
kono
parents:
diff changeset
142
kono
parents:
diff changeset
143 -- In this situation, the initial alignment of t is 4, copied from
kono
parents:
diff changeset
144 -- the Integer base type, but it is safe to reduce it to 1 at this
kono
parents:
diff changeset
145 -- stage, since we will only be loading a single storage unit.
kono
parents:
diff changeset
146
kono
parents:
diff changeset
147 if Is_Discrete_Type (Etype (E)) and then not Has_Alignment_Clause (E)
kono
parents:
diff changeset
148 then
kono
parents:
diff changeset
149 loop
kono
parents:
diff changeset
150 Abits := Abits / 2;
kono
parents:
diff changeset
151 exit when Esize (E) mod Abits = 0;
kono
parents:
diff changeset
152 end loop;
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 Init_Alignment (E, Abits / SSU);
kono
parents:
diff changeset
155 return;
kono
parents:
diff changeset
156 end if;
kono
parents:
diff changeset
157
kono
parents:
diff changeset
158 -- Now the only possible approach left is to increase the Esize but we
kono
parents:
diff changeset
159 -- can't do that if the size was set by a specific clause.
kono
parents:
diff changeset
160
kono
parents:
diff changeset
161 if Esize_Set then
kono
parents:
diff changeset
162 Error_Msg_NE
kono
parents:
diff changeset
163 ("size for& is not a multiple of alignment",
kono
parents:
diff changeset
164 Size_Clause (E), E);
kono
parents:
diff changeset
165
kono
parents:
diff changeset
166 -- Otherwise we can indeed increase the size to a multiple of alignment
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 else
kono
parents:
diff changeset
169 Set_Esize (E, ((Esize (E) + (Abits - 1)) / Abits) * Abits);
kono
parents:
diff changeset
170 end if;
kono
parents:
diff changeset
171 end Adjust_Esize_Alignment;
kono
parents:
diff changeset
172
kono
parents:
diff changeset
173 ------------------------------------------
kono
parents:
diff changeset
174 -- Compute_Size_Depends_On_Discriminant --
kono
parents:
diff changeset
175 ------------------------------------------
kono
parents:
diff changeset
176
kono
parents:
diff changeset
177 procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id) is
kono
parents:
diff changeset
178 Indx : Node_Id;
kono
parents:
diff changeset
179 Ityp : Entity_Id;
kono
parents:
diff changeset
180 Lo : Node_Id;
kono
parents:
diff changeset
181 Hi : Node_Id;
kono
parents:
diff changeset
182 Res : Boolean := False;
kono
parents:
diff changeset
183
kono
parents:
diff changeset
184 begin
kono
parents:
diff changeset
185 -- Loop to process array indexes
kono
parents:
diff changeset
186
kono
parents:
diff changeset
187 Indx := First_Index (E);
kono
parents:
diff changeset
188 while Present (Indx) loop
kono
parents:
diff changeset
189 Ityp := Etype (Indx);
kono
parents:
diff changeset
190
kono
parents:
diff changeset
191 -- If an index of the array is a generic formal type then there is
kono
parents:
diff changeset
192 -- no point in determining a size for the array type.
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 if Is_Generic_Type (Ityp) then
kono
parents:
diff changeset
195 return;
kono
parents:
diff changeset
196 end if;
kono
parents:
diff changeset
197
kono
parents:
diff changeset
198 Lo := Type_Low_Bound (Ityp);
kono
parents:
diff changeset
199 Hi := Type_High_Bound (Ityp);
kono
parents:
diff changeset
200
kono
parents:
diff changeset
201 if (Nkind (Lo) = N_Identifier
kono
parents:
diff changeset
202 and then Ekind (Entity (Lo)) = E_Discriminant)
kono
parents:
diff changeset
203 or else
kono
parents:
diff changeset
204 (Nkind (Hi) = N_Identifier
kono
parents:
diff changeset
205 and then Ekind (Entity (Hi)) = E_Discriminant)
kono
parents:
diff changeset
206 then
kono
parents:
diff changeset
207 Res := True;
kono
parents:
diff changeset
208 end if;
kono
parents:
diff changeset
209
kono
parents:
diff changeset
210 Next_Index (Indx);
kono
parents:
diff changeset
211 end loop;
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 if Res then
kono
parents:
diff changeset
214 Set_Size_Depends_On_Discriminant (E);
kono
parents:
diff changeset
215 end if;
kono
parents:
diff changeset
216 end Compute_Size_Depends_On_Discriminant;
kono
parents:
diff changeset
217
kono
parents:
diff changeset
218 -------------------
kono
parents:
diff changeset
219 -- Layout_Object --
kono
parents:
diff changeset
220 -------------------
kono
parents:
diff changeset
221
kono
parents:
diff changeset
222 procedure Layout_Object (E : Entity_Id) is
kono
parents:
diff changeset
223 pragma Unreferenced (E);
kono
parents:
diff changeset
224 begin
kono
parents:
diff changeset
225 -- Nothing to do for now, assume backend does the layout
kono
parents:
diff changeset
226
kono
parents:
diff changeset
227 return;
kono
parents:
diff changeset
228 end Layout_Object;
kono
parents:
diff changeset
229
kono
parents:
diff changeset
230 -----------------
kono
parents:
diff changeset
231 -- Layout_Type --
kono
parents:
diff changeset
232 -----------------
kono
parents:
diff changeset
233
kono
parents:
diff changeset
234 procedure Layout_Type (E : Entity_Id) is
kono
parents:
diff changeset
235 Desig_Type : Entity_Id;
kono
parents:
diff changeset
236
kono
parents:
diff changeset
237 begin
kono
parents:
diff changeset
238 -- For string literal types, for now, kill the size always, this is
kono
parents:
diff changeset
239 -- because gigi does not like or need the size to be set ???
kono
parents:
diff changeset
240
kono
parents:
diff changeset
241 if Ekind (E) = E_String_Literal_Subtype then
kono
parents:
diff changeset
242 Set_Esize (E, Uint_0);
kono
parents:
diff changeset
243 Set_RM_Size (E, Uint_0);
kono
parents:
diff changeset
244 return;
kono
parents:
diff changeset
245 end if;
kono
parents:
diff changeset
246
kono
parents:
diff changeset
247 -- For access types, set size/alignment. This is system address size,
kono
parents:
diff changeset
248 -- except for fat pointers (unconstrained array access types), where the
kono
parents:
diff changeset
249 -- size is two times the address size, to accommodate the two pointers
kono
parents:
diff changeset
250 -- that are required for a fat pointer (data and template). Note that
kono
parents:
diff changeset
251 -- E_Access_Protected_Subprogram_Type is not an access type for this
kono
parents:
diff changeset
252 -- purpose since it is not a pointer but is equivalent to a record. For
kono
parents:
diff changeset
253 -- access subtypes, copy the size from the base type since Gigi
kono
parents:
diff changeset
254 -- represents them the same way.
kono
parents:
diff changeset
255
kono
parents:
diff changeset
256 if Is_Access_Type (E) then
kono
parents:
diff changeset
257 Desig_Type := Underlying_Type (Designated_Type (E));
kono
parents:
diff changeset
258
kono
parents:
diff changeset
259 -- If we only have a limited view of the type, see whether the
kono
parents:
diff changeset
260 -- non-limited view is available.
kono
parents:
diff changeset
261
kono
parents:
diff changeset
262 if From_Limited_With (Designated_Type (E))
kono
parents:
diff changeset
263 and then Ekind (Designated_Type (E)) = E_Incomplete_Type
kono
parents:
diff changeset
264 and then Present (Non_Limited_View (Designated_Type (E)))
kono
parents:
diff changeset
265 then
kono
parents:
diff changeset
266 Desig_Type := Non_Limited_View (Designated_Type (E));
kono
parents:
diff changeset
267 end if;
kono
parents:
diff changeset
268
kono
parents:
diff changeset
269 -- If Esize already set (e.g. by a size clause), then nothing further
kono
parents:
diff changeset
270 -- to be done here.
kono
parents:
diff changeset
271
kono
parents:
diff changeset
272 if Known_Esize (E) then
kono
parents:
diff changeset
273 null;
kono
parents:
diff changeset
274
kono
parents:
diff changeset
275 -- Access to subprogram is a strange beast, and we let the backend
kono
parents:
diff changeset
276 -- figure out what is needed (it may be some kind of fat pointer,
kono
parents:
diff changeset
277 -- including the static link for example.
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 elsif Is_Access_Protected_Subprogram_Type (E) then
kono
parents:
diff changeset
280 null;
kono
parents:
diff changeset
281
kono
parents:
diff changeset
282 -- For access subtypes, copy the size information from base type
kono
parents:
diff changeset
283
kono
parents:
diff changeset
284 elsif Ekind (E) = E_Access_Subtype then
kono
parents:
diff changeset
285 Set_Size_Info (E, Base_Type (E));
kono
parents:
diff changeset
286 Set_RM_Size (E, RM_Size (Base_Type (E)));
kono
parents:
diff changeset
287
kono
parents:
diff changeset
288 -- For other access types, we use either address size, or, if a fat
kono
parents:
diff changeset
289 -- pointer is used (pointer-to-unconstrained array case), twice the
kono
parents:
diff changeset
290 -- address size to accommodate a fat pointer.
kono
parents:
diff changeset
291
kono
parents:
diff changeset
292 elsif Present (Desig_Type)
kono
parents:
diff changeset
293 and then Is_Array_Type (Desig_Type)
kono
parents:
diff changeset
294 and then not Is_Constrained (Desig_Type)
kono
parents:
diff changeset
295 and then not Has_Completion_In_Body (Desig_Type)
kono
parents:
diff changeset
296
kono
parents:
diff changeset
297 -- Debug Flag -gnatd6 says make all pointers to unconstrained thin
kono
parents:
diff changeset
298
kono
parents:
diff changeset
299 and then not Debug_Flag_6
kono
parents:
diff changeset
300 then
kono
parents:
diff changeset
301 Init_Size (E, 2 * System_Address_Size);
kono
parents:
diff changeset
302
kono
parents:
diff changeset
303 -- Check for bad convention set
kono
parents:
diff changeset
304
kono
parents:
diff changeset
305 if Warn_On_Export_Import
kono
parents:
diff changeset
306 and then
kono
parents:
diff changeset
307 (Convention (E) = Convention_C
kono
parents:
diff changeset
308 or else
kono
parents:
diff changeset
309 Convention (E) = Convention_CPP)
kono
parents:
diff changeset
310 then
kono
parents:
diff changeset
311 Error_Msg_N
kono
parents:
diff changeset
312 ("?x?this access type does not correspond to C pointer", E);
kono
parents:
diff changeset
313 end if;
kono
parents:
diff changeset
314
kono
parents:
diff changeset
315 -- If the designated type is a limited view it is unanalyzed. We can
kono
parents:
diff changeset
316 -- examine the declaration itself to determine whether it will need a
kono
parents:
diff changeset
317 -- fat pointer.
kono
parents:
diff changeset
318
kono
parents:
diff changeset
319 elsif Present (Desig_Type)
kono
parents:
diff changeset
320 and then Present (Parent (Desig_Type))
kono
parents:
diff changeset
321 and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
kono
parents:
diff changeset
322 and then Nkind (Type_Definition (Parent (Desig_Type))) =
kono
parents:
diff changeset
323 N_Unconstrained_Array_Definition
kono
parents:
diff changeset
324 and then not Debug_Flag_6
kono
parents:
diff changeset
325 then
kono
parents:
diff changeset
326 Init_Size (E, 2 * System_Address_Size);
kono
parents:
diff changeset
327
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
328 -- If unnesting subprograms, subprogram access types contain the
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
329 -- address of both the subprogram and an activation record. But if we
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
330 -- set that, we'll get a warning on different unchecked conversion
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
331 -- sizes in the RTS. So leave unset in that case.
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
332
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
333 elsif Unnest_Subprogram_Mode
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
334 and then Is_Access_Subprogram_Type (E)
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
335 then
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
336 null;
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
337
111
kono
parents:
diff changeset
338 -- Normal case of thin pointer
kono
parents:
diff changeset
339
kono
parents:
diff changeset
340 else
kono
parents:
diff changeset
341 Init_Size (E, System_Address_Size);
kono
parents:
diff changeset
342 end if;
kono
parents:
diff changeset
343
kono
parents:
diff changeset
344 Set_Elem_Alignment (E);
kono
parents:
diff changeset
345
kono
parents:
diff changeset
346 -- Scalar types: set size and alignment
kono
parents:
diff changeset
347
kono
parents:
diff changeset
348 elsif Is_Scalar_Type (E) then
kono
parents:
diff changeset
349
kono
parents:
diff changeset
350 -- For discrete types, the RM_Size and Esize must be set already,
kono
parents:
diff changeset
351 -- since this is part of the earlier processing and the front end is
kono
parents:
diff changeset
352 -- always required to lay out the sizes of such types (since they are
kono
parents:
diff changeset
353 -- available as static attributes). All we do is to check that this
kono
parents:
diff changeset
354 -- rule is indeed obeyed.
kono
parents:
diff changeset
355
kono
parents:
diff changeset
356 if Is_Discrete_Type (E) then
kono
parents:
diff changeset
357
kono
parents:
diff changeset
358 -- If the RM_Size is not set, then here is where we set it
kono
parents:
diff changeset
359
kono
parents:
diff changeset
360 -- Note: an RM_Size of zero looks like not set here, but this
kono
parents:
diff changeset
361 -- is a rare case, and we can simply reset it without any harm.
kono
parents:
diff changeset
362
kono
parents:
diff changeset
363 if not Known_RM_Size (E) then
kono
parents:
diff changeset
364 Set_Discrete_RM_Size (E);
kono
parents:
diff changeset
365 end if;
kono
parents:
diff changeset
366
kono
parents:
diff changeset
367 -- If Esize for a discrete type is not set then set it
kono
parents:
diff changeset
368
kono
parents:
diff changeset
369 if not Known_Esize (E) then
kono
parents:
diff changeset
370 declare
kono
parents:
diff changeset
371 S : Int := 8;
kono
parents:
diff changeset
372
kono
parents:
diff changeset
373 begin
kono
parents:
diff changeset
374 loop
kono
parents:
diff changeset
375 -- If size is big enough, set it and exit
kono
parents:
diff changeset
376
kono
parents:
diff changeset
377 if S >= RM_Size (E) then
kono
parents:
diff changeset
378 Init_Esize (E, S);
kono
parents:
diff changeset
379 exit;
kono
parents:
diff changeset
380
kono
parents:
diff changeset
381 -- If the RM_Size is greater than 64 (happens only when
kono
parents:
diff changeset
382 -- strange values are specified by the user, then Esize
kono
parents:
diff changeset
383 -- is simply a copy of RM_Size, it will be further
kono
parents:
diff changeset
384 -- refined later on)
kono
parents:
diff changeset
385
kono
parents:
diff changeset
386 elsif S = 64 then
kono
parents:
diff changeset
387 Set_Esize (E, RM_Size (E));
kono
parents:
diff changeset
388 exit;
kono
parents:
diff changeset
389
kono
parents:
diff changeset
390 -- Otherwise double possible size and keep trying
kono
parents:
diff changeset
391
kono
parents:
diff changeset
392 else
kono
parents:
diff changeset
393 S := S * 2;
kono
parents:
diff changeset
394 end if;
kono
parents:
diff changeset
395 end loop;
kono
parents:
diff changeset
396 end;
kono
parents:
diff changeset
397 end if;
kono
parents:
diff changeset
398
kono
parents:
diff changeset
399 -- For non-discrete scalar types, if the RM_Size is not set, then set
kono
parents:
diff changeset
400 -- it now to a copy of the Esize if the Esize is set.
kono
parents:
diff changeset
401
kono
parents:
diff changeset
402 else
kono
parents:
diff changeset
403 if Known_Esize (E) and then Unknown_RM_Size (E) then
kono
parents:
diff changeset
404 Set_RM_Size (E, Esize (E));
kono
parents:
diff changeset
405 end if;
kono
parents:
diff changeset
406 end if;
kono
parents:
diff changeset
407
kono
parents:
diff changeset
408 Set_Elem_Alignment (E);
kono
parents:
diff changeset
409
kono
parents:
diff changeset
410 -- Non-elementary (composite) types
kono
parents:
diff changeset
411
kono
parents:
diff changeset
412 else
kono
parents:
diff changeset
413 -- For packed arrays, take size and alignment values from the packed
kono
parents:
diff changeset
414 -- array type if a packed array type has been created and the fields
kono
parents:
diff changeset
415 -- are not currently set.
kono
parents:
diff changeset
416
kono
parents:
diff changeset
417 if Is_Array_Type (E)
kono
parents:
diff changeset
418 and then Present (Packed_Array_Impl_Type (E))
kono
parents:
diff changeset
419 then
kono
parents:
diff changeset
420 declare
kono
parents:
diff changeset
421 PAT : constant Entity_Id := Packed_Array_Impl_Type (E);
kono
parents:
diff changeset
422
kono
parents:
diff changeset
423 begin
kono
parents:
diff changeset
424 if Unknown_Esize (E) then
kono
parents:
diff changeset
425 Set_Esize (E, Esize (PAT));
kono
parents:
diff changeset
426 end if;
kono
parents:
diff changeset
427
kono
parents:
diff changeset
428 if Unknown_RM_Size (E) then
kono
parents:
diff changeset
429 Set_RM_Size (E, RM_Size (PAT));
kono
parents:
diff changeset
430 end if;
kono
parents:
diff changeset
431
kono
parents:
diff changeset
432 if Unknown_Alignment (E) then
kono
parents:
diff changeset
433 Set_Alignment (E, Alignment (PAT));
kono
parents:
diff changeset
434 end if;
kono
parents:
diff changeset
435 end;
kono
parents:
diff changeset
436 end if;
kono
parents:
diff changeset
437
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
438 -- For array base types, set the component size if object size of the
111
kono
parents:
diff changeset
439 -- component type is known and is a small power of 2 (8, 16, 32, 64),
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
440 -- since this is what will always be used, except if a very large
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
441 -- alignment was specified and so Adjust_Esize_For_Alignment gave up
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
442 -- because, in this case, the object size is not a multiple of the
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
443 -- alignment and, therefore, cannot be the component size.
111
kono
parents:
diff changeset
444
kono
parents:
diff changeset
445 if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then
kono
parents:
diff changeset
446 declare
kono
parents:
diff changeset
447 CT : constant Entity_Id := Component_Type (E);
kono
parents:
diff changeset
448
kono
parents:
diff changeset
449 begin
kono
parents:
diff changeset
450 -- For some reason, access types can cause trouble, So let's
kono
parents:
diff changeset
451 -- just do this for scalar types ???
kono
parents:
diff changeset
452
kono
parents:
diff changeset
453 if Present (CT)
kono
parents:
diff changeset
454 and then Is_Scalar_Type (CT)
kono
parents:
diff changeset
455 and then Known_Static_Esize (CT)
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
456 and then not (Known_Alignment (CT)
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
457 and then Alignment_In_Bits (CT) >
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
458 Standard_Long_Long_Integer_Size)
111
kono
parents:
diff changeset
459 then
kono
parents:
diff changeset
460 declare
kono
parents:
diff changeset
461 S : constant Uint := Esize (CT);
kono
parents:
diff changeset
462 begin
kono
parents:
diff changeset
463 if Addressable (S) then
kono
parents:
diff changeset
464 Set_Component_Size (E, S);
kono
parents:
diff changeset
465 end if;
kono
parents:
diff changeset
466 end;
kono
parents:
diff changeset
467 end if;
kono
parents:
diff changeset
468 end;
kono
parents:
diff changeset
469 end if;
kono
parents:
diff changeset
470 end if;
kono
parents:
diff changeset
471
kono
parents:
diff changeset
472 -- Even if the backend performs the layout, we still do a little in
kono
parents:
diff changeset
473 -- the front end
kono
parents:
diff changeset
474
kono
parents:
diff changeset
475 -- Processing for record types
kono
parents:
diff changeset
476
kono
parents:
diff changeset
477 if Is_Record_Type (E) then
kono
parents:
diff changeset
478
kono
parents:
diff changeset
479 -- Special remaining processing for record types with a known
kono
parents:
diff changeset
480 -- size of 16, 32, or 64 bits whose alignment is not yet set.
kono
parents:
diff changeset
481 -- For these types, we set a corresponding alignment matching
kono
parents:
diff changeset
482 -- the size if possible, or as large as possible if not.
kono
parents:
diff changeset
483
kono
parents:
diff changeset
484 if Convention (E) = Convention_Ada and then not Debug_Flag_Q then
kono
parents:
diff changeset
485 Set_Composite_Alignment (E);
kono
parents:
diff changeset
486 end if;
kono
parents:
diff changeset
487
kono
parents:
diff changeset
488 -- Processing for array types
kono
parents:
diff changeset
489
kono
parents:
diff changeset
490 elsif Is_Array_Type (E) then
kono
parents:
diff changeset
491
kono
parents:
diff changeset
492 -- For arrays that are required to be atomic/VFA, we do the same
kono
parents:
diff changeset
493 -- processing as described above for short records, since we
kono
parents:
diff changeset
494 -- really need to have the alignment set for the whole array.
kono
parents:
diff changeset
495
kono
parents:
diff changeset
496 if Is_Atomic_Or_VFA (E) and then not Debug_Flag_Q then
kono
parents:
diff changeset
497 Set_Composite_Alignment (E);
kono
parents:
diff changeset
498 end if;
kono
parents:
diff changeset
499
kono
parents:
diff changeset
500 -- For unpacked array types, set an alignment of 1 if we know
kono
parents:
diff changeset
501 -- that the component alignment is not greater than 1. The reason
kono
parents:
diff changeset
502 -- we do this is to avoid unnecessary copying of slices of such
kono
parents:
diff changeset
503 -- arrays when passed to subprogram parameters (see special test
kono
parents:
diff changeset
504 -- in Exp_Ch6.Expand_Actuals).
kono
parents:
diff changeset
505
kono
parents:
diff changeset
506 if not Is_Packed (E) and then Unknown_Alignment (E) then
kono
parents:
diff changeset
507 if Known_Static_Component_Size (E)
kono
parents:
diff changeset
508 and then Component_Size (E) = 1
kono
parents:
diff changeset
509 then
kono
parents:
diff changeset
510 Set_Alignment (E, Uint_1);
kono
parents:
diff changeset
511 end if;
kono
parents:
diff changeset
512 end if;
kono
parents:
diff changeset
513
kono
parents:
diff changeset
514 -- We need to know whether the size depends on the value of one
kono
parents:
diff changeset
515 -- or more discriminants to select the return mechanism. Skip if
kono
parents:
diff changeset
516 -- errors are present, to prevent cascaded messages.
kono
parents:
diff changeset
517
kono
parents:
diff changeset
518 if Serious_Errors_Detected = 0 then
kono
parents:
diff changeset
519 Compute_Size_Depends_On_Discriminant (E);
kono
parents:
diff changeset
520 end if;
kono
parents:
diff changeset
521 end if;
kono
parents:
diff changeset
522
kono
parents:
diff changeset
523 -- Final step is to check that Esize and RM_Size are compatible
kono
parents:
diff changeset
524
kono
parents:
diff changeset
525 if Known_Static_Esize (E) and then Known_Static_RM_Size (E) then
kono
parents:
diff changeset
526 if Esize (E) < RM_Size (E) then
kono
parents:
diff changeset
527
kono
parents:
diff changeset
528 -- Esize is less than RM_Size. That's not good. First we test
kono
parents:
diff changeset
529 -- whether this was set deliberately with an Object_Size clause
kono
parents:
diff changeset
530 -- and if so, object to the clause.
kono
parents:
diff changeset
531
kono
parents:
diff changeset
532 if Has_Object_Size_Clause (E) then
kono
parents:
diff changeset
533 Error_Msg_Uint_1 := RM_Size (E);
kono
parents:
diff changeset
534 Error_Msg_F
kono
parents:
diff changeset
535 ("object size is too small, minimum allowed is ^",
kono
parents:
diff changeset
536 Expression (Get_Attribute_Definition_Clause
kono
parents:
diff changeset
537 (E, Attribute_Object_Size)));
kono
parents:
diff changeset
538 end if;
kono
parents:
diff changeset
539
kono
parents:
diff changeset
540 -- Adjust Esize up to RM_Size value
kono
parents:
diff changeset
541
kono
parents:
diff changeset
542 declare
kono
parents:
diff changeset
543 Size : constant Uint := RM_Size (E);
kono
parents:
diff changeset
544
kono
parents:
diff changeset
545 begin
kono
parents:
diff changeset
546 Set_Esize (E, RM_Size (E));
kono
parents:
diff changeset
547
kono
parents:
diff changeset
548 -- For scalar types, increase Object_Size to power of 2, but
kono
parents:
diff changeset
549 -- not less than a storage unit in any case (i.e., normally
kono
parents:
diff changeset
550 -- this means it will be storage-unit addressable).
kono
parents:
diff changeset
551
kono
parents:
diff changeset
552 if Is_Scalar_Type (E) then
kono
parents:
diff changeset
553 if Size <= SSU then
kono
parents:
diff changeset
554 Init_Esize (E, SSU);
kono
parents:
diff changeset
555 elsif Size <= 16 then
kono
parents:
diff changeset
556 Init_Esize (E, 16);
kono
parents:
diff changeset
557 elsif Size <= 32 then
kono
parents:
diff changeset
558 Init_Esize (E, 32);
kono
parents:
diff changeset
559 else
kono
parents:
diff changeset
560 Set_Esize (E, (Size + 63) / 64 * 64);
kono
parents:
diff changeset
561 end if;
kono
parents:
diff changeset
562
kono
parents:
diff changeset
563 -- Finally, make sure that alignment is consistent with
kono
parents:
diff changeset
564 -- the newly assigned size.
kono
parents:
diff changeset
565
kono
parents:
diff changeset
566 while Alignment (E) * SSU < Esize (E)
kono
parents:
diff changeset
567 and then Alignment (E) < Maximum_Alignment
kono
parents:
diff changeset
568 loop
kono
parents:
diff changeset
569 Set_Alignment (E, 2 * Alignment (E));
kono
parents:
diff changeset
570 end loop;
kono
parents:
diff changeset
571 end if;
kono
parents:
diff changeset
572 end;
kono
parents:
diff changeset
573 end if;
kono
parents:
diff changeset
574 end if;
kono
parents:
diff changeset
575 end Layout_Type;
kono
parents:
diff changeset
576
kono
parents:
diff changeset
577 -----------------------------
kono
parents:
diff changeset
578 -- Set_Composite_Alignment --
kono
parents:
diff changeset
579 -----------------------------
kono
parents:
diff changeset
580
kono
parents:
diff changeset
581 procedure Set_Composite_Alignment (E : Entity_Id) is
kono
parents:
diff changeset
582 Siz : Uint;
kono
parents:
diff changeset
583 Align : Nat;
kono
parents:
diff changeset
584
kono
parents:
diff changeset
585 begin
kono
parents:
diff changeset
586 -- If alignment is already set, then nothing to do
kono
parents:
diff changeset
587
kono
parents:
diff changeset
588 if Known_Alignment (E) then
kono
parents:
diff changeset
589 return;
kono
parents:
diff changeset
590 end if;
kono
parents:
diff changeset
591
kono
parents:
diff changeset
592 -- Alignment is not known, see if we can set it, taking into account
kono
parents:
diff changeset
593 -- the setting of the Optimize_Alignment mode.
kono
parents:
diff changeset
594
kono
parents:
diff changeset
595 -- If Optimize_Alignment is set to Space, then we try to give packed
kono
parents:
diff changeset
596 -- records an aligmment of 1, unless there is some reason we can't.
kono
parents:
diff changeset
597
kono
parents:
diff changeset
598 if Optimize_Alignment_Space (E)
kono
parents:
diff changeset
599 and then Is_Record_Type (E)
kono
parents:
diff changeset
600 and then Is_Packed (E)
kono
parents:
diff changeset
601 then
kono
parents:
diff changeset
602 -- No effect for record with atomic/VFA components
kono
parents:
diff changeset
603
kono
parents:
diff changeset
604 if Is_Atomic_Or_VFA (E) then
kono
parents:
diff changeset
605 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
kono
parents:
diff changeset
606
kono
parents:
diff changeset
607 if Is_Atomic (E) then
kono
parents:
diff changeset
608 Error_Msg_N
kono
parents:
diff changeset
609 ("\pragma ignored for atomic record??", E);
kono
parents:
diff changeset
610 else
kono
parents:
diff changeset
611 Error_Msg_N
kono
parents:
diff changeset
612 ("\pragma ignored for bolatile full access record??", E);
kono
parents:
diff changeset
613 end if;
kono
parents:
diff changeset
614
kono
parents:
diff changeset
615 return;
kono
parents:
diff changeset
616 end if;
kono
parents:
diff changeset
617
kono
parents:
diff changeset
618 -- No effect if independent components
kono
parents:
diff changeset
619
kono
parents:
diff changeset
620 if Has_Independent_Components (E) then
kono
parents:
diff changeset
621 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
kono
parents:
diff changeset
622 Error_Msg_N
kono
parents:
diff changeset
623 ("\pragma ignored for record with independent components??", E);
kono
parents:
diff changeset
624 return;
kono
parents:
diff changeset
625 end if;
kono
parents:
diff changeset
626
kono
parents:
diff changeset
627 -- No effect if any component is atomic/VFA or is a by-reference type
kono
parents:
diff changeset
628
kono
parents:
diff changeset
629 declare
kono
parents:
diff changeset
630 Ent : Entity_Id;
kono
parents:
diff changeset
631
kono
parents:
diff changeset
632 begin
kono
parents:
diff changeset
633 Ent := First_Component_Or_Discriminant (E);
kono
parents:
diff changeset
634 while Present (Ent) loop
kono
parents:
diff changeset
635 if Is_By_Reference_Type (Etype (Ent))
kono
parents:
diff changeset
636 or else Is_Atomic_Or_VFA (Etype (Ent))
kono
parents:
diff changeset
637 or else Is_Atomic_Or_VFA (Ent)
kono
parents:
diff changeset
638 then
kono
parents:
diff changeset
639 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
kono
parents:
diff changeset
640
kono
parents:
diff changeset
641 if Is_Atomic (Etype (Ent)) or else Is_Atomic (Ent) then
kono
parents:
diff changeset
642 Error_Msg_N
kono
parents:
diff changeset
643 ("\pragma is ignored if atomic "
kono
parents:
diff changeset
644 & "components present??", E);
kono
parents:
diff changeset
645 else
kono
parents:
diff changeset
646 Error_Msg_N
kono
parents:
diff changeset
647 ("\pragma is ignored if bolatile full access "
kono
parents:
diff changeset
648 & "components present??", E);
kono
parents:
diff changeset
649 end if;
kono
parents:
diff changeset
650
kono
parents:
diff changeset
651 return;
kono
parents:
diff changeset
652 else
kono
parents:
diff changeset
653 Next_Component_Or_Discriminant (Ent);
kono
parents:
diff changeset
654 end if;
kono
parents:
diff changeset
655 end loop;
kono
parents:
diff changeset
656 end;
kono
parents:
diff changeset
657
kono
parents:
diff changeset
658 -- Optimize_Alignment has no effect on variable length record
kono
parents:
diff changeset
659
kono
parents:
diff changeset
660 if not Size_Known_At_Compile_Time (E) then
kono
parents:
diff changeset
661 Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
kono
parents:
diff changeset
662 Error_Msg_N ("\pragma is ignored for variable length record??", E);
kono
parents:
diff changeset
663 return;
kono
parents:
diff changeset
664 end if;
kono
parents:
diff changeset
665
kono
parents:
diff changeset
666 -- All tests passed, we can set alignment to 1
kono
parents:
diff changeset
667
kono
parents:
diff changeset
668 Align := 1;
kono
parents:
diff changeset
669
kono
parents:
diff changeset
670 -- Not a record, or not packed
kono
parents:
diff changeset
671
kono
parents:
diff changeset
672 else
kono
parents:
diff changeset
673 -- The only other cases we worry about here are where the size is
kono
parents:
diff changeset
674 -- statically known at compile time.
kono
parents:
diff changeset
675
kono
parents:
diff changeset
676 if Known_Static_Esize (E) then
kono
parents:
diff changeset
677 Siz := Esize (E);
kono
parents:
diff changeset
678 elsif Unknown_Esize (E) and then Known_Static_RM_Size (E) then
kono
parents:
diff changeset
679 Siz := RM_Size (E);
kono
parents:
diff changeset
680 else
kono
parents:
diff changeset
681 return;
kono
parents:
diff changeset
682 end if;
kono
parents:
diff changeset
683
kono
parents:
diff changeset
684 -- Size is known, alignment is not set
kono
parents:
diff changeset
685
kono
parents:
diff changeset
686 -- Reset alignment to match size if the known size is exactly 2, 4,
kono
parents:
diff changeset
687 -- or 8 storage units.
kono
parents:
diff changeset
688
kono
parents:
diff changeset
689 if Siz = 2 * SSU then
kono
parents:
diff changeset
690 Align := 2;
kono
parents:
diff changeset
691 elsif Siz = 4 * SSU then
kono
parents:
diff changeset
692 Align := 4;
kono
parents:
diff changeset
693 elsif Siz = 8 * SSU then
kono
parents:
diff changeset
694 Align := 8;
kono
parents:
diff changeset
695
kono
parents:
diff changeset
696 -- If Optimize_Alignment is set to Space, then make sure the
kono
parents:
diff changeset
697 -- alignment matches the size, for example, if the size is 17
kono
parents:
diff changeset
698 -- bytes then we want an alignment of 1 for the type.
kono
parents:
diff changeset
699
kono
parents:
diff changeset
700 elsif Optimize_Alignment_Space (E) then
kono
parents:
diff changeset
701 if Siz mod (8 * SSU) = 0 then
kono
parents:
diff changeset
702 Align := 8;
kono
parents:
diff changeset
703 elsif Siz mod (4 * SSU) = 0 then
kono
parents:
diff changeset
704 Align := 4;
kono
parents:
diff changeset
705 elsif Siz mod (2 * SSU) = 0 then
kono
parents:
diff changeset
706 Align := 2;
kono
parents:
diff changeset
707 else
kono
parents:
diff changeset
708 Align := 1;
kono
parents:
diff changeset
709 end if;
kono
parents:
diff changeset
710
kono
parents:
diff changeset
711 -- If Optimize_Alignment is set to Time, then we reset for odd
kono
parents:
diff changeset
712 -- "in between sizes", for example a 17 bit record is given an
kono
parents:
diff changeset
713 -- alignment of 4.
kono
parents:
diff changeset
714
kono
parents:
diff changeset
715 elsif Optimize_Alignment_Time (E)
kono
parents:
diff changeset
716 and then Siz > SSU
kono
parents:
diff changeset
717 and then Siz <= 8 * SSU
kono
parents:
diff changeset
718 then
kono
parents:
diff changeset
719 if Siz <= 2 * SSU then
kono
parents:
diff changeset
720 Align := 2;
kono
parents:
diff changeset
721 elsif Siz <= 4 * SSU then
kono
parents:
diff changeset
722 Align := 4;
kono
parents:
diff changeset
723 else -- Siz <= 8 * SSU then
kono
parents:
diff changeset
724 Align := 8;
kono
parents:
diff changeset
725 end if;
kono
parents:
diff changeset
726
kono
parents:
diff changeset
727 -- No special alignment fiddling needed
kono
parents:
diff changeset
728
kono
parents:
diff changeset
729 else
kono
parents:
diff changeset
730 return;
kono
parents:
diff changeset
731 end if;
kono
parents:
diff changeset
732 end if;
kono
parents:
diff changeset
733
kono
parents:
diff changeset
734 -- Here we have Set Align to the proposed improved value. Make sure the
kono
parents:
diff changeset
735 -- value set does not exceed Maximum_Alignment for the target.
kono
parents:
diff changeset
736
kono
parents:
diff changeset
737 if Align > Maximum_Alignment then
kono
parents:
diff changeset
738 Align := Maximum_Alignment;
kono
parents:
diff changeset
739 end if;
kono
parents:
diff changeset
740
kono
parents:
diff changeset
741 -- Further processing for record types only to reduce the alignment
kono
parents:
diff changeset
742 -- set by the above processing in some specific cases. We do not
kono
parents:
diff changeset
743 -- do this for atomic/VFA records, since we need max alignment there,
kono
parents:
diff changeset
744
kono
parents:
diff changeset
745 if Is_Record_Type (E) and then not Is_Atomic_Or_VFA (E) then
kono
parents:
diff changeset
746
kono
parents:
diff changeset
747 -- For records, there is generally no point in setting alignment
kono
parents:
diff changeset
748 -- higher than word size since we cannot do better than move by
kono
parents:
diff changeset
749 -- words in any case. Omit this if we are optimizing for time,
kono
parents:
diff changeset
750 -- since conceivably we may be able to do better.
kono
parents:
diff changeset
751
kono
parents:
diff changeset
752 if Align > System_Word_Size / SSU
kono
parents:
diff changeset
753 and then not Optimize_Alignment_Time (E)
kono
parents:
diff changeset
754 then
kono
parents:
diff changeset
755 Align := System_Word_Size / SSU;
kono
parents:
diff changeset
756 end if;
kono
parents:
diff changeset
757
kono
parents:
diff changeset
758 -- Check components. If any component requires a higher alignment,
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
759 -- then we set that higher alignment in any case. Don't do this if we
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
760 -- have Optimize_Alignment set to Space. Note that covers the case of
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
761 -- packed records, where we already set alignment to 1.
111
kono
parents:
diff changeset
762
kono
parents:
diff changeset
763 if not Optimize_Alignment_Space (E) then
kono
parents:
diff changeset
764 declare
kono
parents:
diff changeset
765 Comp : Entity_Id;
kono
parents:
diff changeset
766
kono
parents:
diff changeset
767 begin
kono
parents:
diff changeset
768 Comp := First_Component (E);
kono
parents:
diff changeset
769 while Present (Comp) loop
kono
parents:
diff changeset
770 if Known_Alignment (Etype (Comp)) then
kono
parents:
diff changeset
771 declare
kono
parents:
diff changeset
772 Calign : constant Uint := Alignment (Etype (Comp));
kono
parents:
diff changeset
773
kono
parents:
diff changeset
774 begin
kono
parents:
diff changeset
775 -- The cases to process are when the alignment of the
kono
parents:
diff changeset
776 -- component type is larger than the alignment we have
kono
parents:
diff changeset
777 -- so far, and either there is no component clause for
kono
parents:
diff changeset
778 -- the component, or the length set by the component
kono
parents:
diff changeset
779 -- clause matches the length of the component type.
kono
parents:
diff changeset
780
kono
parents:
diff changeset
781 if Calign > Align
kono
parents:
diff changeset
782 and then
kono
parents:
diff changeset
783 (Unknown_Esize (Comp)
kono
parents:
diff changeset
784 or else (Known_Static_Esize (Comp)
kono
parents:
diff changeset
785 and then
kono
parents:
diff changeset
786 Esize (Comp) = Calign * SSU))
kono
parents:
diff changeset
787 then
kono
parents:
diff changeset
788 Align := UI_To_Int (Calign);
kono
parents:
diff changeset
789 end if;
kono
parents:
diff changeset
790 end;
kono
parents:
diff changeset
791 end if;
kono
parents:
diff changeset
792
kono
parents:
diff changeset
793 Next_Component (Comp);
kono
parents:
diff changeset
794 end loop;
kono
parents:
diff changeset
795 end;
kono
parents:
diff changeset
796 end if;
kono
parents:
diff changeset
797 end if;
kono
parents:
diff changeset
798
kono
parents:
diff changeset
799 -- Set chosen alignment, and increase Esize if necessary to match the
kono
parents:
diff changeset
800 -- chosen alignment.
kono
parents:
diff changeset
801
kono
parents:
diff changeset
802 Set_Alignment (E, UI_From_Int (Align));
kono
parents:
diff changeset
803
kono
parents:
diff changeset
804 if Known_Static_Esize (E)
kono
parents:
diff changeset
805 and then Esize (E) < Align * SSU
kono
parents:
diff changeset
806 then
kono
parents:
diff changeset
807 Set_Esize (E, UI_From_Int (Align * SSU));
kono
parents:
diff changeset
808 end if;
kono
parents:
diff changeset
809 end Set_Composite_Alignment;
kono
parents:
diff changeset
810
kono
parents:
diff changeset
811 --------------------------
kono
parents:
diff changeset
812 -- Set_Discrete_RM_Size --
kono
parents:
diff changeset
813 --------------------------
kono
parents:
diff changeset
814
kono
parents:
diff changeset
815 procedure Set_Discrete_RM_Size (Def_Id : Entity_Id) is
kono
parents:
diff changeset
816 FST : constant Entity_Id := First_Subtype (Def_Id);
kono
parents:
diff changeset
817
kono
parents:
diff changeset
818 begin
kono
parents:
diff changeset
819 -- All discrete types except for the base types in standard are
kono
parents:
diff changeset
820 -- constrained, so indicate this by setting Is_Constrained.
kono
parents:
diff changeset
821
kono
parents:
diff changeset
822 Set_Is_Constrained (Def_Id);
kono
parents:
diff changeset
823
kono
parents:
diff changeset
824 -- Set generic types to have an unknown size, since the representation
kono
parents:
diff changeset
825 -- of a generic type is irrelevant, in view of the fact that they have
kono
parents:
diff changeset
826 -- nothing to do with code.
kono
parents:
diff changeset
827
kono
parents:
diff changeset
828 if Is_Generic_Type (Root_Type (FST)) then
kono
parents:
diff changeset
829 Set_RM_Size (Def_Id, Uint_0);
kono
parents:
diff changeset
830
kono
parents:
diff changeset
831 -- If the subtype statically matches the first subtype, then it is
kono
parents:
diff changeset
832 -- required to have exactly the same layout. This is required by
kono
parents:
diff changeset
833 -- aliasing considerations.
kono
parents:
diff changeset
834
kono
parents:
diff changeset
835 elsif Def_Id /= FST and then
kono
parents:
diff changeset
836 Subtypes_Statically_Match (Def_Id, FST)
kono
parents:
diff changeset
837 then
kono
parents:
diff changeset
838 Set_RM_Size (Def_Id, RM_Size (FST));
kono
parents:
diff changeset
839 Set_Size_Info (Def_Id, FST);
kono
parents:
diff changeset
840
kono
parents:
diff changeset
841 -- In all other cases the RM_Size is set to the minimum size. Note that
kono
parents:
diff changeset
842 -- this routine is never called for subtypes for which the RM_Size is
kono
parents:
diff changeset
843 -- set explicitly by an attribute clause.
kono
parents:
diff changeset
844
kono
parents:
diff changeset
845 else
kono
parents:
diff changeset
846 Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id)));
kono
parents:
diff changeset
847 end if;
kono
parents:
diff changeset
848 end Set_Discrete_RM_Size;
kono
parents:
diff changeset
849
kono
parents:
diff changeset
850 ------------------------
kono
parents:
diff changeset
851 -- Set_Elem_Alignment --
kono
parents:
diff changeset
852 ------------------------
kono
parents:
diff changeset
853
kono
parents:
diff changeset
854 procedure Set_Elem_Alignment (E : Entity_Id; Align : Nat := 0) is
kono
parents:
diff changeset
855 begin
kono
parents:
diff changeset
856 -- Do not set alignment for packed array types, this is handled in the
kono
parents:
diff changeset
857 -- backend.
kono
parents:
diff changeset
858
kono
parents:
diff changeset
859 if Is_Packed_Array_Impl_Type (E) then
kono
parents:
diff changeset
860 return;
kono
parents:
diff changeset
861
kono
parents:
diff changeset
862 -- If there is an alignment clause, then we respect it
kono
parents:
diff changeset
863
kono
parents:
diff changeset
864 elsif Has_Alignment_Clause (E) then
kono
parents:
diff changeset
865 return;
kono
parents:
diff changeset
866
kono
parents:
diff changeset
867 -- If the size is not set, then don't attempt to set the alignment. This
kono
parents:
diff changeset
868 -- happens in the backend layout case for access-to-subprogram types.
kono
parents:
diff changeset
869
kono
parents:
diff changeset
870 elsif not Known_Static_Esize (E) then
kono
parents:
diff changeset
871 return;
kono
parents:
diff changeset
872
kono
parents:
diff changeset
873 -- For access types, do not set the alignment if the size is less than
kono
parents:
diff changeset
874 -- the allowed minimum size. This avoids cascaded error messages.
kono
parents:
diff changeset
875
kono
parents:
diff changeset
876 elsif Is_Access_Type (E) and then Esize (E) < System_Address_Size then
kono
parents:
diff changeset
877 return;
kono
parents:
diff changeset
878 end if;
kono
parents:
diff changeset
879
kono
parents:
diff changeset
880 -- We attempt to set the alignment in all the other cases
kono
parents:
diff changeset
881
kono
parents:
diff changeset
882 declare
kono
parents:
diff changeset
883 S : Int;
kono
parents:
diff changeset
884 A : Nat;
kono
parents:
diff changeset
885 M : Nat;
kono
parents:
diff changeset
886
kono
parents:
diff changeset
887 begin
kono
parents:
diff changeset
888 -- The given Esize may be larger that int'last because of a previous
kono
parents:
diff changeset
889 -- error, and the call to UI_To_Int will fail, so use default.
kono
parents:
diff changeset
890
kono
parents:
diff changeset
891 if Esize (E) / SSU > Ttypes.Maximum_Alignment then
kono
parents:
diff changeset
892 S := Ttypes.Maximum_Alignment;
kono
parents:
diff changeset
893
kono
parents:
diff changeset
894 -- If this is an access type and the target doesn't have strict
kono
parents:
diff changeset
895 -- alignment, then cap the alignment to that of a regular access
kono
parents:
diff changeset
896 -- type. This will avoid giving fat pointers twice the usual
kono
parents:
diff changeset
897 -- alignment for no practical benefit since the misalignment doesn't
kono
parents:
diff changeset
898 -- really matter.
kono
parents:
diff changeset
899
kono
parents:
diff changeset
900 elsif Is_Access_Type (E)
kono
parents:
diff changeset
901 and then not Target_Strict_Alignment
kono
parents:
diff changeset
902 then
kono
parents:
diff changeset
903 S := System_Address_Size / SSU;
kono
parents:
diff changeset
904
kono
parents:
diff changeset
905 else
kono
parents:
diff changeset
906 S := UI_To_Int (Esize (E)) / SSU;
kono
parents:
diff changeset
907 end if;
kono
parents:
diff changeset
908
kono
parents:
diff changeset
909 -- If the default alignment of "double" floating-point types is
kono
parents:
diff changeset
910 -- specifically capped, enforce the cap.
kono
parents:
diff changeset
911
kono
parents:
diff changeset
912 if Ttypes.Target_Double_Float_Alignment > 0
kono
parents:
diff changeset
913 and then S = 8
kono
parents:
diff changeset
914 and then Is_Floating_Point_Type (E)
kono
parents:
diff changeset
915 then
kono
parents:
diff changeset
916 M := Ttypes.Target_Double_Float_Alignment;
kono
parents:
diff changeset
917
kono
parents:
diff changeset
918 -- If the default alignment of "double" or larger scalar types is
kono
parents:
diff changeset
919 -- specifically capped, enforce the cap.
kono
parents:
diff changeset
920
kono
parents:
diff changeset
921 elsif Ttypes.Target_Double_Scalar_Alignment > 0
kono
parents:
diff changeset
922 and then S >= 8
kono
parents:
diff changeset
923 and then Is_Scalar_Type (E)
kono
parents:
diff changeset
924 then
kono
parents:
diff changeset
925 M := Ttypes.Target_Double_Scalar_Alignment;
kono
parents:
diff changeset
926
kono
parents:
diff changeset
927 -- Otherwise enforce the overall alignment cap
kono
parents:
diff changeset
928
kono
parents:
diff changeset
929 else
kono
parents:
diff changeset
930 M := Ttypes.Maximum_Alignment;
kono
parents:
diff changeset
931 end if;
kono
parents:
diff changeset
932
kono
parents:
diff changeset
933 -- We calculate the alignment as the largest power-of-two multiple
kono
parents:
diff changeset
934 -- of System.Storage_Unit that does not exceed the object size of
kono
parents:
diff changeset
935 -- the type and the maximum allowed alignment, if none was specified.
kono
parents:
diff changeset
936 -- Otherwise we only cap it to the maximum allowed alignment.
kono
parents:
diff changeset
937
kono
parents:
diff changeset
938 if Align = 0 then
kono
parents:
diff changeset
939 A := 1;
kono
parents:
diff changeset
940 while 2 * A <= S and then 2 * A <= M loop
kono
parents:
diff changeset
941 A := 2 * A;
kono
parents:
diff changeset
942 end loop;
kono
parents:
diff changeset
943 else
kono
parents:
diff changeset
944 A := Nat'Min (Align, M);
kono
parents:
diff changeset
945 end if;
kono
parents:
diff changeset
946
kono
parents:
diff changeset
947 -- If alignment is currently not set, then we can safely set it to
kono
parents:
diff changeset
948 -- this new calculated value.
kono
parents:
diff changeset
949
kono
parents:
diff changeset
950 if Unknown_Alignment (E) then
kono
parents:
diff changeset
951 Init_Alignment (E, A);
kono
parents:
diff changeset
952
kono
parents:
diff changeset
953 -- Cases where we have inherited an alignment
kono
parents:
diff changeset
954
kono
parents:
diff changeset
955 -- For constructed types, always reset the alignment, these are
kono
parents:
diff changeset
956 -- generally invisible to the user anyway, and that way we are
kono
parents:
diff changeset
957 -- sure that no constructed types have weird alignments.
kono
parents:
diff changeset
958
kono
parents:
diff changeset
959 elsif not Comes_From_Source (E) then
kono
parents:
diff changeset
960 Init_Alignment (E, A);
kono
parents:
diff changeset
961
kono
parents:
diff changeset
962 -- If this inherited alignment is the same as the one we computed,
kono
parents:
diff changeset
963 -- then obviously everything is fine, and we do not need to reset it.
kono
parents:
diff changeset
964
kono
parents:
diff changeset
965 elsif Alignment (E) = A then
kono
parents:
diff changeset
966 null;
kono
parents:
diff changeset
967
kono
parents:
diff changeset
968 else
kono
parents:
diff changeset
969 -- Now we come to the difficult cases of subtypes for which we
kono
parents:
diff changeset
970 -- have inherited an alignment different from the computed one.
kono
parents:
diff changeset
971 -- We resort to the presence of alignment and size clauses to
kono
parents:
diff changeset
972 -- guide our choices. Note that they can generally be present
kono
parents:
diff changeset
973 -- only on the first subtype (except for Object_Size) and that
kono
parents:
diff changeset
974 -- we need to look at the Rep_Item chain to correctly handle
kono
parents:
diff changeset
975 -- derived types.
kono
parents:
diff changeset
976
kono
parents:
diff changeset
977 declare
kono
parents:
diff changeset
978 FST : constant Entity_Id := First_Subtype (E);
kono
parents:
diff changeset
979
kono
parents:
diff changeset
980 function Has_Attribute_Clause
kono
parents:
diff changeset
981 (E : Entity_Id;
kono
parents:
diff changeset
982 Id : Attribute_Id) return Boolean;
kono
parents:
diff changeset
983 -- Wrapper around Get_Attribute_Definition_Clause which tests
kono
parents:
diff changeset
984 -- for the presence of the specified attribute clause.
kono
parents:
diff changeset
985
kono
parents:
diff changeset
986 --------------------------
kono
parents:
diff changeset
987 -- Has_Attribute_Clause --
kono
parents:
diff changeset
988 --------------------------
kono
parents:
diff changeset
989
kono
parents:
diff changeset
990 function Has_Attribute_Clause
kono
parents:
diff changeset
991 (E : Entity_Id;
kono
parents:
diff changeset
992 Id : Attribute_Id) return Boolean is
kono
parents:
diff changeset
993 begin
kono
parents:
diff changeset
994 return Present (Get_Attribute_Definition_Clause (E, Id));
kono
parents:
diff changeset
995 end Has_Attribute_Clause;
kono
parents:
diff changeset
996
kono
parents:
diff changeset
997 begin
kono
parents:
diff changeset
998 -- If the alignment comes from a clause, then we respect it.
kono
parents:
diff changeset
999 -- Consider for example:
kono
parents:
diff changeset
1000
kono
parents:
diff changeset
1001 -- type R is new Character;
kono
parents:
diff changeset
1002 -- for R'Alignment use 1;
kono
parents:
diff changeset
1003 -- for R'Size use 16;
kono
parents:
diff changeset
1004 -- subtype S is R;
kono
parents:
diff changeset
1005
kono
parents:
diff changeset
1006 -- Here R has a specified size of 16 and a specified alignment
kono
parents:
diff changeset
1007 -- of 1, and it seems right for S to inherit both values.
kono
parents:
diff changeset
1008
kono
parents:
diff changeset
1009 if Has_Attribute_Clause (FST, Attribute_Alignment) then
kono
parents:
diff changeset
1010 null;
kono
parents:
diff changeset
1011
kono
parents:
diff changeset
1012 -- Now we come to the cases where we have inherited alignment
kono
parents:
diff changeset
1013 -- and size, and overridden the size but not the alignment.
kono
parents:
diff changeset
1014
kono
parents:
diff changeset
1015 elsif Has_Attribute_Clause (FST, Attribute_Size)
kono
parents:
diff changeset
1016 or else Has_Attribute_Clause (FST, Attribute_Object_Size)
kono
parents:
diff changeset
1017 or else Has_Attribute_Clause (E, Attribute_Object_Size)
kono
parents:
diff changeset
1018 then
kono
parents:
diff changeset
1019 -- This is tricky, it might be thought that we should try to
kono
parents:
diff changeset
1020 -- inherit the alignment, since that's what the RM implies,
kono
parents:
diff changeset
1021 -- but that leads to complex rules and oddities. Consider
kono
parents:
diff changeset
1022 -- for example:
kono
parents:
diff changeset
1023
kono
parents:
diff changeset
1024 -- type R is new Character;
kono
parents:
diff changeset
1025 -- for R'Size use 16;
kono
parents:
diff changeset
1026
kono
parents:
diff changeset
1027 -- It seems quite bogus in this case to inherit an alignment
kono
parents:
diff changeset
1028 -- of 1 from the parent type Character. Furthermore, if that
kono
parents:
diff changeset
1029 -- is what the programmer really wanted for some odd reason,
kono
parents:
diff changeset
1030 -- then he could specify the alignment directly.
kono
parents:
diff changeset
1031
kono
parents:
diff changeset
1032 -- Moreover we really don't want to inherit the alignment in
kono
parents:
diff changeset
1033 -- the case of a specified Object_Size for a subtype, since
kono
parents:
diff changeset
1034 -- there would be no way of overriding to give a reasonable
kono
parents:
diff changeset
1035 -- value (as we don't have an Object_Alignment attribute).
kono
parents:
diff changeset
1036 -- Consider for example:
kono
parents:
diff changeset
1037
kono
parents:
diff changeset
1038 -- subtype R is Character;
kono
parents:
diff changeset
1039 -- for R'Object_Size use 16;
kono
parents:
diff changeset
1040
kono
parents:
diff changeset
1041 -- If we inherit the alignment of 1, then it will be very
kono
parents:
diff changeset
1042 -- inefficient for the subtype and this cannot be fixed.
kono
parents:
diff changeset
1043
kono
parents:
diff changeset
1044 -- So we make the decision that if Size (or Object_Size) is
kono
parents:
diff changeset
1045 -- given and the alignment is not specified with a clause,
kono
parents:
diff changeset
1046 -- we reset the alignment to the appropriate value for the
kono
parents:
diff changeset
1047 -- specified size. This is a nice simple rule to implement
kono
parents:
diff changeset
1048 -- and document.
kono
parents:
diff changeset
1049
kono
parents:
diff changeset
1050 -- There is a theoretical glitch, which is that a confirming
kono
parents:
diff changeset
1051 -- size clause could now change the alignment, which, if we
kono
parents:
diff changeset
1052 -- really think that confirming rep clauses should have no
kono
parents:
diff changeset
1053 -- effect, could be seen as a no-no. However that's already
kono
parents:
diff changeset
1054 -- implemented by Alignment_Check_For_Size_Change so we do
kono
parents:
diff changeset
1055 -- not change the philosophy here.
kono
parents:
diff changeset
1056
kono
parents:
diff changeset
1057 -- Historical note: in versions prior to Nov 6th, 2011, an
kono
parents:
diff changeset
1058 -- odd distinction was made between inherited alignments
kono
parents:
diff changeset
1059 -- larger than the computed alignment (where the larger
kono
parents:
diff changeset
1060 -- alignment was inherited) and inherited alignments smaller
kono
parents:
diff changeset
1061 -- than the computed alignment (where the smaller alignment
kono
parents:
diff changeset
1062 -- was overridden). This was a dubious fix to get around an
kono
parents:
diff changeset
1063 -- ACATS problem which seems to have disappeared anyway, and
kono
parents:
diff changeset
1064 -- in any case, this peculiarity was never documented.
kono
parents:
diff changeset
1065
kono
parents:
diff changeset
1066 Init_Alignment (E, A);
kono
parents:
diff changeset
1067
kono
parents:
diff changeset
1068 -- If no Size (or Object_Size) was specified, then we have
kono
parents:
diff changeset
1069 -- inherited the object size, so we should also inherit the
kono
parents:
diff changeset
1070 -- alignment and not modify it.
kono
parents:
diff changeset
1071
kono
parents:
diff changeset
1072 else
kono
parents:
diff changeset
1073 null;
kono
parents:
diff changeset
1074 end if;
kono
parents:
diff changeset
1075 end;
kono
parents:
diff changeset
1076 end if;
kono
parents:
diff changeset
1077 end;
kono
parents:
diff changeset
1078 end Set_Elem_Alignment;
kono
parents:
diff changeset
1079
kono
parents:
diff changeset
1080 end Layout;