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