]>
Commit | Line | Data |
---|---|---|
83cce46b | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- L A Y O U T -- | |
6 | -- -- | |
7 | -- B o d y -- | |
83cce46b | 8 | -- -- |
a60794e6 | 9 | -- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- |
83cce46b | 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- -- | |
80df182a | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
83cce46b | 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 -- | |
80df182a | 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. -- | |
83cce46b | 20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
e78e8c8e | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
83cce46b | 23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | with Atree; use Atree; | |
27 | with Checks; use Checks; | |
28 | with Debug; use Debug; | |
29 | with Einfo; use Einfo; | |
30 | with Errout; use Errout; | |
31 | with Exp_Ch3; use Exp_Ch3; | |
32 | with Exp_Util; use Exp_Util; | |
cd6ff0dc | 33 | with Namet; use Namet; |
83cce46b | 34 | with Nlists; use Nlists; |
35 | with Nmake; use Nmake; | |
9dfe12ae | 36 | with Opt; use Opt; |
83cce46b | 37 | with Repinfo; use Repinfo; |
38 | with Sem; use Sem; | |
d60c9ff7 | 39 | with Sem_Aux; use Sem_Aux; |
83cce46b | 40 | with Sem_Ch13; use Sem_Ch13; |
41 | with Sem_Eval; use Sem_Eval; | |
83cce46b | 42 | with Sem_Util; use Sem_Util; |
43 | with Sinfo; use Sinfo; | |
44 | with Snames; use Snames; | |
45 | with Stand; use Stand; | |
46 | with Targparm; use Targparm; | |
47 | with Tbuild; use Tbuild; | |
48 | with Ttypes; use Ttypes; | |
49 | with Uintp; use Uintp; | |
50 | ||
51 | package body Layout is | |
52 | ||
53 | ------------------------ | |
54 | -- Local Declarations -- | |
55 | ------------------------ | |
56 | ||
57 | SSU : constant Int := Ttypes.System_Storage_Unit; | |
58 | -- Short hand for System_Storage_Unit | |
59 | ||
60 | Vname : constant Name_Id := Name_uV; | |
61 | -- Formal parameter name used for functions generated for size offset | |
62 | -- values that depend on the discriminant. All such functions have the | |
63 | -- following form: | |
64 | -- | |
65 | -- function xxx (V : vtyp) return Unsigned is | |
66 | -- begin | |
67 | -- return ... expression involving V.discrim | |
68 | -- end xxx; | |
69 | ||
70 | ----------------------- | |
71 | -- Local Subprograms -- | |
72 | ----------------------- | |
73 | ||
83cce46b | 74 | function Assoc_Add |
75 | (Loc : Source_Ptr; | |
76 | Left_Opnd : Node_Id; | |
d1cf00c6 | 77 | Right_Opnd : Node_Id) return Node_Id; |
83cce46b | 78 | -- This is like Make_Op_Add except that it optimizes some cases knowing |
79 | -- that associative rearrangement is allowed for constant folding if one | |
80 | -- of the operands is a compile time known value. | |
81 | ||
82 | function Assoc_Multiply | |
83 | (Loc : Source_Ptr; | |
84 | Left_Opnd : Node_Id; | |
d1cf00c6 | 85 | Right_Opnd : Node_Id) return Node_Id; |
83cce46b | 86 | -- This is like Make_Op_Multiply except that it optimizes some cases |
5e640318 | 87 | -- knowing that associative rearrangement is allowed for constant folding |
88 | -- if one of the operands is a compile time known value | |
83cce46b | 89 | |
90 | function Assoc_Subtract | |
91 | (Loc : Source_Ptr; | |
92 | Left_Opnd : Node_Id; | |
d1cf00c6 | 93 | Right_Opnd : Node_Id) return Node_Id; |
83cce46b | 94 | -- This is like Make_Op_Subtract except that it optimizes some cases |
5e640318 | 95 | -- knowing that associative rearrangement is allowed for constant folding |
96 | -- if one of the operands is a compile time known value | |
83cce46b | 97 | |
9dfe12ae | 98 | function Bits_To_SU (N : Node_Id) return Node_Id; |
99 | -- This is used when we cross the boundary from static sizes in bits to | |
100 | -- dynamic sizes in storage units. If the argument N is anything other | |
101 | -- than an integer literal, it is returned unchanged, but if it is an | |
102 | -- integer literal, then it is taken as a size in bits, and is replaced | |
35c57fc7 | 103 | -- by the corresponding size in storage units. |
9dfe12ae | 104 | |
83cce46b | 105 | function Compute_Length (Lo : Node_Id; Hi : Node_Id) return Node_Id; |
106 | -- Given expressions for the low bound (Lo) and the high bound (Hi), | |
107 | -- Build an expression for the value hi-lo+1, converted to type | |
108 | -- Standard.Unsigned. Takes care of the case where the operands | |
109 | -- are of an enumeration type (so that the subtraction cannot be | |
110 | -- done directly) by applying the Pos operator to Hi/Lo first. | |
111 | ||
4524d1ce | 112 | procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id); |
113 | -- Given an array type or an array subtype E, compute whether its size | |
114 | -- depends on the value of one or more discriminants and set the flag | |
115 | -- Size_Depends_On_Discriminant accordingly. This need not be called | |
116 | -- in front end layout mode since it does the computation on its own. | |
117 | ||
83cce46b | 118 | function Expr_From_SO_Ref |
119 | (Loc : Source_Ptr; | |
9dfe12ae | 120 | D : SO_Ref; |
d1cf00c6 | 121 | Comp : Entity_Id := Empty) return Node_Id; |
83cce46b | 122 | -- Given a value D from a size or offset field, return an expression |
123 | -- representing the value stored. If the value is known at compile time, | |
124 | -- then an N_Integer_Literal is returned with the appropriate value. If | |
125 | -- the value references a constant entity, then an N_Identifier node | |
9dfe12ae | 126 | -- referencing this entity is returned. If the value denotes a size |
127 | -- function, then returns a call node denoting the given function, with | |
128 | -- a single actual parameter that either refers to the parameter V of | |
129 | -- an enclosing size function (if Comp is Empty or its type doesn't match | |
130 | -- the function's formal), or else is a selected component V.c when Comp | |
131 | -- denotes a component c whose type matches that of the function formal. | |
132 | -- The Loc value is used for the Sloc value of constructed notes. | |
83cce46b | 133 | |
134 | function SO_Ref_From_Expr | |
135 | (Expr : Node_Id; | |
136 | Ins_Type : Entity_Id; | |
9dfe12ae | 137 | Vtype : Entity_Id := Empty; |
d1cf00c6 | 138 | Make_Func : Boolean := False) return Dynamic_SO_Ref; |
83cce46b | 139 | -- This routine is used in the case where a size/offset value is dynamic |
140 | -- and is represented by the expression Expr. SO_Ref_From_Expr checks if | |
141 | -- the Expr contains a reference to the identifier V, and if so builds | |
142 | -- a function depending on discriminants of the formal parameter V which | |
9dfe12ae | 143 | -- is of type Vtype. Otherwise, if the parameter Make_Func is True, then |
144 | -- Expr will be encapsulated in a parameterless function; if Make_Func is | |
145 | -- False, then a constant entity with the value Expr is built. The result | |
146 | -- is a Dynamic_SO_Ref to the created entity. Note that Vtype can be | |
147 | -- omitted if Expr does not contain any reference to V, the created entity. | |
148 | -- The declaration created is inserted in the freeze actions of Ins_Type, | |
149 | -- which also supplies the Sloc for created nodes. This function also takes | |
150 | -- care of making sure that the expression is properly analyzed and | |
151 | -- resolved (which may not be the case yet if we build the expression | |
152 | -- in this unit). | |
83cce46b | 153 | |
35c57fc7 | 154 | function Get_Max_SU_Size (E : Entity_Id) return Node_Id; |
83cce46b | 155 | -- E is an array type or subtype that has at least one index bound that |
156 | -- is the value of a record discriminant. For such an array, the function | |
157 | -- computes an expression that yields the maximum possible size of the | |
158 | -- array in storage units. The result is not defined for any other type, | |
159 | -- or for arrays that do not depend on discriminants, and it is a fatal | |
9dfe12ae | 160 | -- error to call this unless Size_Depends_On_Discriminant (E) is True. |
83cce46b | 161 | |
162 | procedure Layout_Array_Type (E : Entity_Id); | |
9dfe12ae | 163 | -- Front-end layout of non-bit-packed array type or subtype |
83cce46b | 164 | |
165 | procedure Layout_Record_Type (E : Entity_Id); | |
9dfe12ae | 166 | -- Front-end layout of record type |
83cce46b | 167 | |
168 | procedure Rewrite_Integer (N : Node_Id; V : Uint); | |
5e640318 | 169 | -- Rewrite node N with an integer literal whose value is V. The Sloc for |
170 | -- the new node is taken from N, and the type of the literal is set to a | |
171 | -- copy of the type of N on entry. | |
83cce46b | 172 | |
173 | procedure Set_And_Check_Static_Size | |
174 | (E : Entity_Id; | |
175 | Esiz : SO_Ref; | |
176 | RM_Siz : SO_Ref); | |
5e640318 | 177 | -- This procedure is called to check explicit given sizes (possibly stored |
178 | -- in the Esize and RM_Size fields of E) against computed Object_Size | |
179 | -- (Esiz) and Value_Size (RM_Siz) values. Appropriate errors and warnings | |
180 | -- are posted if specified sizes are inconsistent with specified sizes. On | |
181 | -- return, Esize and RM_Size fields of E are set (either from previously | |
182 | -- given values, or from the newly computed values, as appropriate). | |
83cce46b | 183 | |
f15731c4 | 184 | procedure Set_Composite_Alignment (E : Entity_Id); |
185 | -- This procedure is called for record types and subtypes, and also for | |
186 | -- atomic array types and subtypes. If no alignment is set, and the size | |
187 | -- is 2 or 4 (or 8 if the word size is 8), then the alignment is set to | |
188 | -- match the size. | |
189 | ||
83cce46b | 190 | ---------------------------- |
191 | -- Adjust_Esize_Alignment -- | |
192 | ---------------------------- | |
193 | ||
194 | procedure Adjust_Esize_Alignment (E : Entity_Id) is | |
195 | Abits : Int; | |
196 | Esize_Set : Boolean; | |
197 | ||
198 | begin | |
199 | -- Nothing to do if size unknown | |
200 | ||
201 | if Unknown_Esize (E) then | |
202 | return; | |
203 | end if; | |
204 | ||
205 | -- Determine if size is constrained by an attribute definition clause | |
206 | -- which must be obeyed. If so, we cannot increase the size in this | |
207 | -- routine. | |
208 | ||
5e640318 | 209 | -- For a type, the issue is whether an object size clause has been set. |
210 | -- A normal size clause constrains only the value size (RM_Size) | |
83cce46b | 211 | |
212 | if Is_Type (E) then | |
213 | Esize_Set := Has_Object_Size_Clause (E); | |
214 | ||
215 | -- For an object, the issue is whether a size clause is present | |
216 | ||
217 | else | |
218 | Esize_Set := Has_Size_Clause (E); | |
219 | end if; | |
220 | ||
35c57fc7 | 221 | -- If size is known it must be a multiple of the storage unit size |
83cce46b | 222 | |
223 | if Esize (E) mod SSU /= 0 then | |
224 | ||
225 | -- If not, and size specified, then give error | |
226 | ||
227 | if Esize_Set then | |
228 | Error_Msg_NE | |
35c57fc7 | 229 | ("size for& not a multiple of storage unit size", |
230 | Size_Clause (E), E); | |
83cce46b | 231 | return; |
232 | ||
35c57fc7 | 233 | -- Otherwise bump up size to a storage unit boundary |
83cce46b | 234 | |
235 | else | |
236 | Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU); | |
237 | end if; | |
238 | end if; | |
239 | ||
240 | -- Now we have the size set, it must be a multiple of the alignment | |
241 | -- nothing more we can do here if the alignment is unknown here. | |
242 | ||
243 | if Unknown_Alignment (E) then | |
244 | return; | |
245 | end if; | |
246 | ||
247 | -- At this point both the Esize and Alignment are known, so we need | |
248 | -- to make sure they are consistent. | |
249 | ||
250 | Abits := UI_To_Int (Alignment (E)) * SSU; | |
251 | ||
252 | if Esize (E) mod Abits = 0 then | |
253 | return; | |
254 | end if; | |
255 | ||
5e640318 | 256 | -- Here we have a situation where the Esize is not a multiple of the |
257 | -- alignment. We must either increase Esize or reduce the alignment to | |
258 | -- correct this situation. | |
83cce46b | 259 | |
260 | -- The case in which we can decrease the alignment is where the | |
261 | -- alignment was not set by an alignment clause, and the type in | |
5e640318 | 262 | -- question is a discrete type, where it is definitely safe to reduce |
263 | -- the alignment. For example: | |
83cce46b | 264 | |
265 | -- t : integer range 1 .. 2; | |
266 | -- for t'size use 8; | |
267 | ||
268 | -- In this situation, the initial alignment of t is 4, copied from | |
269 | -- the Integer base type, but it is safe to reduce it to 1 at this | |
35c57fc7 | 270 | -- stage, since we will only be loading a single storage unit. |
83cce46b | 271 | |
272 | if Is_Discrete_Type (Etype (E)) | |
273 | and then not Has_Alignment_Clause (E) | |
274 | then | |
275 | loop | |
276 | Abits := Abits / 2; | |
277 | exit when Esize (E) mod Abits = 0; | |
278 | end loop; | |
279 | ||
280 | Init_Alignment (E, Abits / SSU); | |
281 | return; | |
282 | end if; | |
283 | ||
5e640318 | 284 | -- Now the only possible approach left is to increase the Esize but we |
285 | -- can't do that if the size was set by a specific clause. | |
83cce46b | 286 | |
287 | if Esize_Set then | |
288 | Error_Msg_NE | |
289 | ("size for& is not a multiple of alignment", | |
290 | Size_Clause (E), E); | |
291 | ||
292 | -- Otherwise we can indeed increase the size to a multiple of alignment | |
293 | ||
294 | else | |
295 | Set_Esize (E, ((Esize (E) + (Abits - 1)) / Abits) * Abits); | |
296 | end if; | |
297 | end Adjust_Esize_Alignment; | |
298 | ||
299 | --------------- | |
300 | -- Assoc_Add -- | |
301 | --------------- | |
302 | ||
303 | function Assoc_Add | |
304 | (Loc : Source_Ptr; | |
305 | Left_Opnd : Node_Id; | |
d1cf00c6 | 306 | Right_Opnd : Node_Id) return Node_Id |
83cce46b | 307 | is |
308 | L : Node_Id; | |
309 | R : Uint; | |
310 | ||
311 | begin | |
312 | -- Case of right operand is a constant | |
313 | ||
314 | if Compile_Time_Known_Value (Right_Opnd) then | |
315 | L := Left_Opnd; | |
316 | R := Expr_Value (Right_Opnd); | |
317 | ||
318 | -- Case of left operand is a constant | |
319 | ||
320 | elsif Compile_Time_Known_Value (Left_Opnd) then | |
321 | L := Right_Opnd; | |
322 | R := Expr_Value (Left_Opnd); | |
323 | ||
324 | -- Neither operand is a constant, do the addition with no optimization | |
325 | ||
326 | else | |
327 | return Make_Op_Add (Loc, Left_Opnd, Right_Opnd); | |
328 | end if; | |
329 | ||
330 | -- Case of left operand is an addition | |
331 | ||
332 | if Nkind (L) = N_Op_Add then | |
333 | ||
334 | -- (C1 + E) + C2 = (C1 + C2) + E | |
335 | ||
336 | if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then | |
337 | Rewrite_Integer | |
338 | (Sinfo.Left_Opnd (L), | |
339 | Expr_Value (Sinfo.Left_Opnd (L)) + R); | |
340 | return L; | |
341 | ||
342 | -- (E + C1) + C2 = E + (C1 + C2) | |
343 | ||
344 | elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then | |
345 | Rewrite_Integer | |
346 | (Sinfo.Right_Opnd (L), | |
347 | Expr_Value (Sinfo.Right_Opnd (L)) + R); | |
348 | return L; | |
349 | end if; | |
350 | ||
351 | -- Case of left operand is a subtraction | |
352 | ||
353 | elsif Nkind (L) = N_Op_Subtract then | |
354 | ||
355 | -- (C1 - E) + C2 = (C1 + C2) + E | |
356 | ||
357 | if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then | |
358 | Rewrite_Integer | |
359 | (Sinfo.Left_Opnd (L), | |
360 | Expr_Value (Sinfo.Left_Opnd (L)) + R); | |
361 | return L; | |
362 | ||
363 | -- (E - C1) + C2 = E - (C1 - C2) | |
364 | ||
365 | elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then | |
366 | Rewrite_Integer | |
367 | (Sinfo.Right_Opnd (L), | |
368 | Expr_Value (Sinfo.Right_Opnd (L)) - R); | |
369 | return L; | |
370 | end if; | |
371 | end if; | |
372 | ||
373 | -- Not optimizable, do the addition | |
374 | ||
375 | return Make_Op_Add (Loc, Left_Opnd, Right_Opnd); | |
376 | end Assoc_Add; | |
377 | ||
378 | -------------------- | |
379 | -- Assoc_Multiply -- | |
380 | -------------------- | |
381 | ||
382 | function Assoc_Multiply | |
383 | (Loc : Source_Ptr; | |
384 | Left_Opnd : Node_Id; | |
d1cf00c6 | 385 | Right_Opnd : Node_Id) return Node_Id |
83cce46b | 386 | is |
387 | L : Node_Id; | |
388 | R : Uint; | |
389 | ||
390 | begin | |
391 | -- Case of right operand is a constant | |
392 | ||
393 | if Compile_Time_Known_Value (Right_Opnd) then | |
394 | L := Left_Opnd; | |
395 | R := Expr_Value (Right_Opnd); | |
396 | ||
397 | -- Case of left operand is a constant | |
398 | ||
399 | elsif Compile_Time_Known_Value (Left_Opnd) then | |
400 | L := Right_Opnd; | |
401 | R := Expr_Value (Left_Opnd); | |
402 | ||
403 | -- Neither operand is a constant, do the multiply with no optimization | |
404 | ||
405 | else | |
406 | return Make_Op_Multiply (Loc, Left_Opnd, Right_Opnd); | |
407 | end if; | |
408 | ||
409 | -- Case of left operand is an multiplication | |
410 | ||
411 | if Nkind (L) = N_Op_Multiply then | |
412 | ||
413 | -- (C1 * E) * C2 = (C1 * C2) + E | |
414 | ||
415 | if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then | |
416 | Rewrite_Integer | |
417 | (Sinfo.Left_Opnd (L), | |
418 | Expr_Value (Sinfo.Left_Opnd (L)) * R); | |
419 | return L; | |
420 | ||
421 | -- (E * C1) * C2 = E * (C1 * C2) | |
422 | ||
423 | elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then | |
424 | Rewrite_Integer | |
425 | (Sinfo.Right_Opnd (L), | |
426 | Expr_Value (Sinfo.Right_Opnd (L)) * R); | |
427 | return L; | |
428 | end if; | |
429 | end if; | |
430 | ||
431 | -- Not optimizable, do the multiplication | |
432 | ||
433 | return Make_Op_Multiply (Loc, Left_Opnd, Right_Opnd); | |
434 | end Assoc_Multiply; | |
435 | ||
436 | -------------------- | |
437 | -- Assoc_Subtract -- | |
438 | -------------------- | |
439 | ||
440 | function Assoc_Subtract | |
441 | (Loc : Source_Ptr; | |
442 | Left_Opnd : Node_Id; | |
d1cf00c6 | 443 | Right_Opnd : Node_Id) return Node_Id |
83cce46b | 444 | is |
445 | L : Node_Id; | |
446 | R : Uint; | |
447 | ||
448 | begin | |
449 | -- Case of right operand is a constant | |
450 | ||
451 | if Compile_Time_Known_Value (Right_Opnd) then | |
452 | L := Left_Opnd; | |
453 | R := Expr_Value (Right_Opnd); | |
454 | ||
455 | -- Right operand is a constant, do the subtract with no optimization | |
456 | ||
457 | else | |
458 | return Make_Op_Subtract (Loc, Left_Opnd, Right_Opnd); | |
459 | end if; | |
460 | ||
461 | -- Case of left operand is an addition | |
462 | ||
463 | if Nkind (L) = N_Op_Add then | |
464 | ||
465 | -- (C1 + E) - C2 = (C1 - C2) + E | |
466 | ||
467 | if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then | |
468 | Rewrite_Integer | |
469 | (Sinfo.Left_Opnd (L), | |
470 | Expr_Value (Sinfo.Left_Opnd (L)) - R); | |
471 | return L; | |
472 | ||
473 | -- (E + C1) - C2 = E + (C1 - C2) | |
474 | ||
475 | elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then | |
476 | Rewrite_Integer | |
477 | (Sinfo.Right_Opnd (L), | |
478 | Expr_Value (Sinfo.Right_Opnd (L)) - R); | |
479 | return L; | |
480 | end if; | |
481 | ||
482 | -- Case of left operand is a subtraction | |
483 | ||
484 | elsif Nkind (L) = N_Op_Subtract then | |
485 | ||
486 | -- (C1 - E) - C2 = (C1 - C2) + E | |
487 | ||
488 | if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then | |
489 | Rewrite_Integer | |
490 | (Sinfo.Left_Opnd (L), | |
491 | Expr_Value (Sinfo.Left_Opnd (L)) + R); | |
492 | return L; | |
493 | ||
494 | -- (E - C1) - C2 = E - (C1 + C2) | |
495 | ||
496 | elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then | |
497 | Rewrite_Integer | |
498 | (Sinfo.Right_Opnd (L), | |
499 | Expr_Value (Sinfo.Right_Opnd (L)) + R); | |
500 | return L; | |
501 | end if; | |
502 | end if; | |
503 | ||
504 | -- Not optimizable, do the subtraction | |
505 | ||
506 | return Make_Op_Subtract (Loc, Left_Opnd, Right_Opnd); | |
507 | end Assoc_Subtract; | |
508 | ||
9dfe12ae | 509 | ---------------- |
510 | -- Bits_To_SU -- | |
511 | ---------------- | |
512 | ||
513 | function Bits_To_SU (N : Node_Id) return Node_Id is | |
514 | begin | |
515 | if Nkind (N) = N_Integer_Literal then | |
516 | Set_Intval (N, (Intval (N) + (SSU - 1)) / SSU); | |
517 | end if; | |
518 | ||
519 | return N; | |
520 | end Bits_To_SU; | |
521 | ||
83cce46b | 522 | -------------------- |
523 | -- Compute_Length -- | |
524 | -------------------- | |
525 | ||
526 | function Compute_Length (Lo : Node_Id; Hi : Node_Id) return Node_Id is | |
9dfe12ae | 527 | Loc : constant Source_Ptr := Sloc (Lo); |
528 | Typ : constant Entity_Id := Etype (Lo); | |
529 | Lo_Op : Node_Id; | |
530 | Hi_Op : Node_Id; | |
531 | Lo_Dim : Uint; | |
532 | Hi_Dim : Uint; | |
83cce46b | 533 | |
534 | begin | |
9dfe12ae | 535 | -- If the bounds are First and Last attributes for the same dimension |
536 | -- and both have prefixes that denotes the same entity, then we create | |
537 | -- and return a Length attribute. This may allow the back end to | |
538 | -- generate better code in cases where it already has the length. | |
539 | ||
540 | if Nkind (Lo) = N_Attribute_Reference | |
541 | and then Attribute_Name (Lo) = Name_First | |
542 | and then Nkind (Hi) = N_Attribute_Reference | |
543 | and then Attribute_Name (Hi) = Name_Last | |
544 | and then Is_Entity_Name (Prefix (Lo)) | |
545 | and then Is_Entity_Name (Prefix (Hi)) | |
546 | and then Entity (Prefix (Lo)) = Entity (Prefix (Hi)) | |
547 | then | |
548 | Lo_Dim := Uint_1; | |
549 | Hi_Dim := Uint_1; | |
550 | ||
551 | if Present (First (Expressions (Lo))) then | |
552 | Lo_Dim := Expr_Value (First (Expressions (Lo))); | |
553 | end if; | |
554 | ||
555 | if Present (First (Expressions (Hi))) then | |
556 | Hi_Dim := Expr_Value (First (Expressions (Hi))); | |
557 | end if; | |
558 | ||
559 | if Lo_Dim = Hi_Dim then | |
560 | return | |
561 | Make_Attribute_Reference (Loc, | |
562 | Prefix => New_Occurrence_Of | |
563 | (Entity (Prefix (Lo)), Loc), | |
564 | Attribute_Name => Name_Length, | |
565 | Expressions => New_List | |
566 | (Make_Integer_Literal (Loc, Lo_Dim))); | |
567 | end if; | |
568 | end if; | |
569 | ||
83cce46b | 570 | Lo_Op := New_Copy_Tree (Lo); |
571 | Hi_Op := New_Copy_Tree (Hi); | |
572 | ||
573 | -- If type is enumeration type, then use Pos attribute to convert | |
574 | -- to integer type for which subtraction is a permitted operation. | |
575 | ||
576 | if Is_Enumeration_Type (Typ) then | |
577 | Lo_Op := | |
578 | Make_Attribute_Reference (Loc, | |
579 | Prefix => New_Occurrence_Of (Typ, Loc), | |
580 | Attribute_Name => Name_Pos, | |
581 | Expressions => New_List (Lo_Op)); | |
582 | ||
583 | Hi_Op := | |
584 | Make_Attribute_Reference (Loc, | |
585 | Prefix => New_Occurrence_Of (Typ, Loc), | |
586 | Attribute_Name => Name_Pos, | |
587 | Expressions => New_List (Hi_Op)); | |
588 | end if; | |
589 | ||
590 | return | |
e4bd5d4a | 591 | Assoc_Add (Loc, |
592 | Left_Opnd => | |
593 | Assoc_Subtract (Loc, | |
594 | Left_Opnd => Hi_Op, | |
595 | Right_Opnd => Lo_Op), | |
596 | Right_Opnd => Make_Integer_Literal (Loc, 1)); | |
83cce46b | 597 | end Compute_Length; |
598 | ||
599 | ---------------------- | |
600 | -- Expr_From_SO_Ref -- | |
601 | ---------------------- | |
602 | ||
603 | function Expr_From_SO_Ref | |
604 | (Loc : Source_Ptr; | |
9dfe12ae | 605 | D : SO_Ref; |
d1cf00c6 | 606 | Comp : Entity_Id := Empty) return Node_Id |
83cce46b | 607 | is |
608 | Ent : Entity_Id; | |
609 | ||
610 | begin | |
611 | if Is_Dynamic_SO_Ref (D) then | |
612 | Ent := Get_Dynamic_SO_Entity (D); | |
613 | ||
614 | if Is_Discrim_SO_Function (Ent) then | |
5e640318 | 615 | |
616 | -- If a component is passed in whose type matches the type of | |
617 | -- the function formal, then select that component from the "V" | |
618 | -- parameter rather than passing "V" directly. | |
9dfe12ae | 619 | |
620 | if Present (Comp) | |
621 | and then Base_Type (Etype (Comp)) | |
622 | = Base_Type (Etype (First_Formal (Ent))) | |
623 | then | |
624 | return | |
625 | Make_Function_Call (Loc, | |
626 | Name => New_Occurrence_Of (Ent, Loc), | |
627 | Parameter_Associations => New_List ( | |
628 | Make_Selected_Component (Loc, | |
55868293 | 629 | Prefix => Make_Identifier (Loc, Vname), |
9dfe12ae | 630 | Selector_Name => New_Occurrence_Of (Comp, Loc)))); |
631 | ||
632 | else | |
633 | return | |
634 | Make_Function_Call (Loc, | |
635 | Name => New_Occurrence_Of (Ent, Loc), | |
636 | Parameter_Associations => New_List ( | |
55868293 | 637 | Make_Identifier (Loc, Vname))); |
9dfe12ae | 638 | end if; |
83cce46b | 639 | |
640 | else | |
641 | return New_Occurrence_Of (Ent, Loc); | |
642 | end if; | |
643 | ||
644 | else | |
645 | return Make_Integer_Literal (Loc, D); | |
646 | end if; | |
647 | end Expr_From_SO_Ref; | |
648 | ||
35c57fc7 | 649 | --------------------- |
650 | -- Get_Max_SU_Size -- | |
651 | --------------------- | |
83cce46b | 652 | |
35c57fc7 | 653 | function Get_Max_SU_Size (E : Entity_Id) return Node_Id is |
83cce46b | 654 | Loc : constant Source_Ptr := Sloc (E); |
655 | Indx : Node_Id; | |
656 | Ityp : Entity_Id; | |
657 | Lo : Node_Id; | |
658 | Hi : Node_Id; | |
659 | S : Uint; | |
660 | Len : Node_Id; | |
661 | ||
662 | type Val_Status_Type is (Const, Dynamic); | |
ca188295 | 663 | |
664 | type Val_Type (Status : Val_Status_Type := Const) is | |
665 | record | |
666 | case Status is | |
667 | when Const => Val : Uint; | |
668 | when Dynamic => Nod : Node_Id; | |
669 | end case; | |
670 | end record; | |
5e640318 | 671 | -- Shows the status of the value so far. Const means that the value is |
672 | -- constant, and Val is the current constant value. Dynamic means that | |
673 | -- the value is dynamic, and in this case Nod is the Node_Id of the | |
674 | -- expression to compute the value. | |
83cce46b | 675 | |
ca188295 | 676 | Size : Val_Type; |
677 | -- Calculated value so far if Size.Status = Const, | |
678 | -- or expression value so far if Size.Status = Dynamic. | |
83cce46b | 679 | |
680 | SU_Convert_Required : Boolean := False; | |
5e640318 | 681 | -- This is set to True if the final result must be converted from bits |
682 | -- to storage units (rounding up to a storage unit boundary). | |
83cce46b | 683 | |
684 | ----------------------- | |
685 | -- Local Subprograms -- | |
686 | ----------------------- | |
687 | ||
688 | procedure Max_Discrim (N : in out Node_Id); | |
689 | -- If the node N represents a discriminant, replace it by the maximum | |
690 | -- value of the discriminant. | |
691 | ||
692 | procedure Min_Discrim (N : in out Node_Id); | |
693 | -- If the node N represents a discriminant, replace it by the minimum | |
694 | -- value of the discriminant. | |
695 | ||
696 | ----------------- | |
697 | -- Max_Discrim -- | |
698 | ----------------- | |
699 | ||
700 | procedure Max_Discrim (N : in out Node_Id) is | |
701 | begin | |
702 | if Nkind (N) = N_Identifier | |
703 | and then Ekind (Entity (N)) = E_Discriminant | |
704 | then | |
705 | N := Type_High_Bound (Etype (N)); | |
706 | end if; | |
707 | end Max_Discrim; | |
708 | ||
709 | ----------------- | |
710 | -- Min_Discrim -- | |
711 | ----------------- | |
712 | ||
713 | procedure Min_Discrim (N : in out Node_Id) is | |
714 | begin | |
715 | if Nkind (N) = N_Identifier | |
716 | and then Ekind (Entity (N)) = E_Discriminant | |
717 | then | |
718 | N := Type_Low_Bound (Etype (N)); | |
719 | end if; | |
720 | end Min_Discrim; | |
721 | ||
35c57fc7 | 722 | -- Start of processing for Get_Max_SU_Size |
83cce46b | 723 | |
724 | begin | |
725 | pragma Assert (Size_Depends_On_Discriminant (E)); | |
726 | ||
727 | -- Initialize status from component size | |
728 | ||
729 | if Known_Static_Component_Size (E) then | |
ca188295 | 730 | Size := (Const, Component_Size (E)); |
83cce46b | 731 | |
732 | else | |
ca188295 | 733 | Size := (Dynamic, Expr_From_SO_Ref (Loc, Component_Size (E))); |
83cce46b | 734 | end if; |
735 | ||
1d00a8ce | 736 | -- Loop through indexes |
83cce46b | 737 | |
738 | Indx := First_Index (E); | |
739 | while Present (Indx) loop | |
740 | Ityp := Etype (Indx); | |
741 | Lo := Type_Low_Bound (Ityp); | |
742 | Hi := Type_High_Bound (Ityp); | |
743 | ||
744 | Min_Discrim (Lo); | |
745 | Max_Discrim (Hi); | |
746 | ||
747 | -- Value of the current subscript range is statically known | |
748 | ||
749 | if Compile_Time_Known_Value (Lo) | |
750 | and then Compile_Time_Known_Value (Hi) | |
751 | then | |
752 | S := Expr_Value (Hi) - Expr_Value (Lo) + 1; | |
753 | ||
754 | -- If known flat bound, entire size of array is zero! | |
755 | ||
756 | if S <= 0 then | |
757 | return Make_Integer_Literal (Loc, 0); | |
758 | end if; | |
759 | ||
760 | -- Current value is constant, evolve value | |
761 | ||
ca188295 | 762 | if Size.Status = Const then |
763 | Size.Val := Size.Val * S; | |
83cce46b | 764 | |
765 | -- Current value is dynamic | |
766 | ||
767 | else | |
768 | -- An interesting little optimization, if we have a pending | |
769 | -- conversion from bits to storage units, and the current | |
770 | -- length is a multiple of the storage unit size, then we | |
771 | -- can take the factor out here statically, avoiding some | |
772 | -- extra dynamic computations at the end. | |
773 | ||
774 | if SU_Convert_Required and then S mod SSU = 0 then | |
775 | S := S / SSU; | |
776 | SU_Convert_Required := False; | |
777 | end if; | |
778 | ||
ca188295 | 779 | Size.Nod := |
83cce46b | 780 | Assoc_Multiply (Loc, |
ca188295 | 781 | Left_Opnd => Size.Nod, |
83cce46b | 782 | Right_Opnd => |
783 | Make_Integer_Literal (Loc, Intval => S)); | |
784 | end if; | |
785 | ||
786 | -- Value of the current subscript range is dynamic | |
787 | ||
788 | else | |
789 | -- If the current size value is constant, then here is where we | |
790 | -- make a transition to dynamic values, which are always stored | |
791 | -- in storage units, However, we do not want to convert to SU's | |
792 | -- too soon, consider the case of a packed array of single bits, | |
793 | -- we want to do the SU conversion after computing the size in | |
794 | -- this case. | |
795 | ||
ca188295 | 796 | if Size.Status = Const then |
83cce46b | 797 | |
798 | -- If the current value is a multiple of the storage unit, | |
799 | -- then most certainly we can do the conversion now, simply | |
800 | -- by dividing the current value by the storage unit value. | |
801 | -- If this works, we set SU_Convert_Required to False. | |
802 | ||
ca188295 | 803 | if Size.Val mod SSU = 0 then |
804 | ||
805 | Size := | |
806 | (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU)); | |
83cce46b | 807 | SU_Convert_Required := False; |
808 | ||
5e640318 | 809 | -- Otherwise, we go ahead and convert the value in bits, and |
810 | -- set SU_Convert_Required to True to ensure that the final | |
811 | -- value is indeed properly converted. | |
83cce46b | 812 | |
813 | else | |
ca188295 | 814 | Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val)); |
83cce46b | 815 | SU_Convert_Required := True; |
816 | end if; | |
817 | end if; | |
818 | ||
819 | -- Length is hi-lo+1 | |
820 | ||
821 | Len := Compute_Length (Lo, Hi); | |
822 | ||
823 | -- Check possible range of Len | |
824 | ||
825 | declare | |
826 | OK : Boolean; | |
827 | LLo : Uint; | |
828 | LHi : Uint; | |
a13923ff | 829 | pragma Warnings (Off, LHi); |
83cce46b | 830 | |
831 | begin | |
832 | Set_Parent (Len, E); | |
833 | Determine_Range (Len, OK, LLo, LHi); | |
834 | ||
e4bd5d4a | 835 | Len := Convert_To (Standard_Unsigned, Len); |
836 | ||
5e640318 | 837 | -- If we cannot verify that range cannot be super-flat, we need |
838 | -- a max with zero, since length must be non-negative. | |
83cce46b | 839 | |
840 | if not OK or else LLo < 0 then | |
841 | Len := | |
842 | Make_Attribute_Reference (Loc, | |
843 | Prefix => | |
844 | New_Occurrence_Of (Standard_Unsigned, Loc), | |
845 | Attribute_Name => Name_Max, | |
846 | Expressions => New_List ( | |
847 | Make_Integer_Literal (Loc, 0), | |
848 | Len)); | |
849 | end if; | |
850 | end; | |
851 | end if; | |
852 | ||
853 | Next_Index (Indx); | |
854 | end loop; | |
855 | ||
5e640318 | 856 | -- Here after processing all bounds to set sizes. If the value is a |
857 | -- constant, then it is bits, so we convert to storage units. | |
83cce46b | 858 | |
ca188295 | 859 | if Size.Status = Const then |
35c57fc7 | 860 | return Bits_To_SU (Make_Integer_Literal (Loc, Size.Val)); |
83cce46b | 861 | |
862 | -- Case where the value is dynamic | |
863 | ||
864 | else | |
865 | -- Do convert from bits to SU's if needed | |
866 | ||
867 | if SU_Convert_Required then | |
868 | ||
ca188295 | 869 | -- The expression required is (Size.Nod + SU - 1) / SU |
83cce46b | 870 | |
ca188295 | 871 | Size.Nod := |
83cce46b | 872 | Make_Op_Divide (Loc, |
873 | Left_Opnd => | |
874 | Make_Op_Add (Loc, | |
ca188295 | 875 | Left_Opnd => Size.Nod, |
83cce46b | 876 | Right_Opnd => Make_Integer_Literal (Loc, SSU - 1)), |
877 | Right_Opnd => Make_Integer_Literal (Loc, SSU)); | |
878 | end if; | |
879 | ||
ca188295 | 880 | return Size.Nod; |
83cce46b | 881 | end if; |
35c57fc7 | 882 | end Get_Max_SU_Size; |
83cce46b | 883 | |
884 | ----------------------- | |
885 | -- Layout_Array_Type -- | |
886 | ----------------------- | |
887 | ||
888 | procedure Layout_Array_Type (E : Entity_Id) is | |
889 | Loc : constant Source_Ptr := Sloc (E); | |
890 | Ctyp : constant Entity_Id := Component_Type (E); | |
891 | Indx : Node_Id; | |
892 | Ityp : Entity_Id; | |
893 | Lo : Node_Id; | |
894 | Hi : Node_Id; | |
895 | S : Uint; | |
896 | Len : Node_Id; | |
897 | ||
898 | Insert_Typ : Entity_Id; | |
899 | -- This is the type with which any generated constants or functions | |
900 | -- will be associated (i.e. inserted into the freeze actions). This | |
9dfe12ae | 901 | -- is normally the type being laid out. The exception occurs when |
83cce46b | 902 | -- we are laying out Itype's which are local to a record type, and |
903 | -- whose scope is this record type. Such types do not have freeze | |
904 | -- nodes (because we have no place to put them). | |
905 | ||
906 | ------------------------------------ | |
9dfe12ae | 907 | -- How An Array Type is Laid Out -- |
83cce46b | 908 | ------------------------------------ |
909 | ||
5e640318 | 910 | -- Here is what goes on. We need to multiply the component size of the |
911 | -- array (which has already been set) by the length of each of the | |
912 | -- indexes. If all these values are known at compile time, then the | |
913 | -- resulting size of the array is the appropriate constant value. | |
83cce46b | 914 | |
915 | -- If the component size or at least one bound is dynamic (but no | |
916 | -- discriminants are present), then the size will be computed as an | |
917 | -- expression that calculates the proper size. | |
918 | ||
919 | -- If there is at least one discriminant bound, then the size is also | |
920 | -- computed as an expression, but this expression contains discriminant | |
921 | -- values which are obtained by selecting from a function parameter, and | |
922 | -- the size is given by a function that is passed the variant record in | |
923 | -- question, and whose body is the expression. | |
924 | ||
925 | type Val_Status_Type is (Const, Dynamic, Discrim); | |
83cce46b | 926 | |
ca188295 | 927 | type Val_Type (Status : Val_Status_Type := Const) is |
928 | record | |
929 | case Status is | |
930 | when Const => | |
931 | Val : Uint; | |
932 | -- Calculated value so far if Val_Status = Const | |
933 | ||
934 | when Dynamic | Discrim => | |
935 | Nod : Node_Id; | |
936 | -- Expression value so far if Val_Status /= Const | |
937 | ||
938 | end case; | |
939 | end record; | |
940 | -- Records the value or expression computed so far. Const means that | |
941 | -- the value is constant, and Val is the current constant value. | |
942 | -- Dynamic means that the value is dynamic, and in this case Nod is | |
943 | -- the Node_Id of the expression to compute the value, and Discrim | |
944 | -- means that at least one bound is a discriminant, in which case Nod | |
945 | -- is the expression so far (which will be the body of the function). | |
946 | ||
947 | Size : Val_Type; | |
3817baeb | 948 | -- Value of size computed so far. See comments above |
ca188295 | 949 | |
950 | Vtyp : Entity_Id := Empty; | |
5e640318 | 951 | -- Variant record type for the formal parameter of the discriminant |
952 | -- function V if Status = Discrim. | |
83cce46b | 953 | |
954 | SU_Convert_Required : Boolean := False; | |
955 | -- This is set to True if the final result must be converted from | |
956 | -- bits to storage units (rounding up to a storage unit boundary). | |
957 | ||
9dfe12ae | 958 | Storage_Divisor : Uint := UI_From_Int (SSU); |
959 | -- This is the amount that a nonstatic computed size will be divided | |
960 | -- by to convert it from bits to storage units. This is normally | |
961 | -- equal to SSU, but can be reduced in the case of packed components | |
962 | -- that fit evenly into a storage unit. | |
963 | ||
964 | Make_Size_Function : Boolean := False; | |
965 | -- Indicates whether to request that SO_Ref_From_Expr should | |
27f48659 | 966 | -- encapsulate the array size expression in a function. |
9dfe12ae | 967 | |
83cce46b | 968 | procedure Discrimify (N : in out Node_Id); |
ca188295 | 969 | -- If N represents a discriminant, then the Size.Status is set to |
83cce46b | 970 | -- Discrim, and Vtyp is set. The parameter N is replaced with the |
971 | -- proper expression to extract the discriminant value from V. | |
972 | ||
973 | ---------------- | |
974 | -- Discrimify -- | |
975 | ---------------- | |
976 | ||
977 | procedure Discrimify (N : in out Node_Id) is | |
978 | Decl : Node_Id; | |
979 | Typ : Entity_Id; | |
980 | ||
981 | begin | |
982 | if Nkind (N) = N_Identifier | |
983 | and then Ekind (Entity (N)) = E_Discriminant | |
984 | then | |
985 | Set_Size_Depends_On_Discriminant (E); | |
986 | ||
ca188295 | 987 | if Size.Status /= Discrim then |
83cce46b | 988 | Decl := Parent (Parent (Entity (N))); |
ca188295 | 989 | Size := (Discrim, Size.Nod); |
83cce46b | 990 | Vtyp := Defining_Identifier (Decl); |
991 | end if; | |
992 | ||
993 | Typ := Etype (N); | |
994 | ||
995 | N := | |
996 | Make_Selected_Component (Loc, | |
55868293 | 997 | Prefix => Make_Identifier (Loc, Vname), |
83cce46b | 998 | Selector_Name => New_Occurrence_Of (Entity (N), Loc)); |
999 | ||
5ddfef5e | 1000 | -- Set the Etype attributes of the selected name and its prefix. |
1001 | -- Analyze_And_Resolve can't be called here because the Vname | |
1002 | -- entity denoted by the prefix will not yet exist (it's created | |
1003 | -- by SO_Ref_From_Expr, called at the end of Layout_Array_Type). | |
1004 | ||
1005 | Set_Etype (Prefix (N), Vtyp); | |
1006 | Set_Etype (N, Typ); | |
83cce46b | 1007 | end if; |
1008 | end Discrimify; | |
1009 | ||
1010 | -- Start of processing for Layout_Array_Type | |
1011 | ||
1012 | begin | |
1013 | -- Default alignment is component alignment | |
1014 | ||
1015 | if Unknown_Alignment (E) then | |
1016 | Set_Alignment (E, Alignment (Ctyp)); | |
1017 | end if; | |
1018 | ||
1019 | -- Calculate proper type for insertions | |
1020 | ||
c2258dde | 1021 | if Is_Record_Type (Underlying_Type (Scope (E))) then |
1022 | Insert_Typ := Underlying_Type (Scope (E)); | |
83cce46b | 1023 | else |
1024 | Insert_Typ := E; | |
1025 | end if; | |
1026 | ||
9dfe12ae | 1027 | -- If the component type is a generic formal type then there's no point |
1028 | -- in determining a size for the array type. | |
1029 | ||
1030 | if Is_Generic_Type (Ctyp) then | |
1031 | return; | |
1032 | end if; | |
1033 | ||
f15731c4 | 1034 | -- Deal with component size if base type |
83cce46b | 1035 | |
f15731c4 | 1036 | if Ekind (E) = E_Array_Type then |
1037 | ||
1038 | -- Cannot do anything if Esize of component type unknown | |
1039 | ||
1040 | if Unknown_Esize (Ctyp) then | |
1041 | return; | |
1042 | end if; | |
83cce46b | 1043 | |
f15731c4 | 1044 | -- Set component size if not set already |
83cce46b | 1045 | |
f15731c4 | 1046 | if Unknown_Component_Size (E) then |
1047 | Set_Component_Size (E, Esize (Ctyp)); | |
1048 | end if; | |
83cce46b | 1049 | end if; |
1050 | ||
1051 | -- (RM 13.3 (48)) says that the size of an unconstrained array | |
1052 | -- is implementation defined. We choose to leave it as Unknown | |
1053 | -- here, and the actual behavior is determined by the back end. | |
1054 | ||
1055 | if not Is_Constrained (E) then | |
1056 | return; | |
1057 | end if; | |
1058 | ||
1059 | -- Initialize status from component size | |
1060 | ||
1061 | if Known_Static_Component_Size (E) then | |
ca188295 | 1062 | Size := (Const, Component_Size (E)); |
83cce46b | 1063 | |
1064 | else | |
ca188295 | 1065 | Size := (Dynamic, Expr_From_SO_Ref (Loc, Component_Size (E))); |
83cce46b | 1066 | end if; |
1067 | ||
1d00a8ce | 1068 | -- Loop to process array indexes |
83cce46b | 1069 | |
1070 | Indx := First_Index (E); | |
1071 | while Present (Indx) loop | |
1072 | Ityp := Etype (Indx); | |
9dfe12ae | 1073 | |
5e640318 | 1074 | -- If an index of the array is a generic formal type then there is |
9dfe12ae | 1075 | -- no point in determining a size for the array type. |
1076 | ||
1077 | if Is_Generic_Type (Ityp) then | |
1078 | return; | |
1079 | end if; | |
1080 | ||
83cce46b | 1081 | Lo := Type_Low_Bound (Ityp); |
1082 | Hi := Type_High_Bound (Ityp); | |
1083 | ||
1084 | -- Value of the current subscript range is statically known | |
1085 | ||
1086 | if Compile_Time_Known_Value (Lo) | |
1087 | and then Compile_Time_Known_Value (Hi) | |
1088 | then | |
1089 | S := Expr_Value (Hi) - Expr_Value (Lo) + 1; | |
1090 | ||
1091 | -- If known flat bound, entire size of array is zero! | |
1092 | ||
1093 | if S <= 0 then | |
1094 | Set_Esize (E, Uint_0); | |
1095 | Set_RM_Size (E, Uint_0); | |
1096 | return; | |
1097 | end if; | |
1098 | ||
1099 | -- If constant, evolve value | |
1100 | ||
ca188295 | 1101 | if Size.Status = Const then |
1102 | Size.Val := Size.Val * S; | |
83cce46b | 1103 | |
1104 | -- Current value is dynamic | |
1105 | ||
1106 | else | |
1107 | -- An interesting little optimization, if we have a pending | |
1108 | -- conversion from bits to storage units, and the current | |
1109 | -- length is a multiple of the storage unit size, then we | |
1110 | -- can take the factor out here statically, avoiding some | |
1111 | -- extra dynamic computations at the end. | |
1112 | ||
1113 | if SU_Convert_Required and then S mod SSU = 0 then | |
1114 | S := S / SSU; | |
1115 | SU_Convert_Required := False; | |
1116 | end if; | |
1117 | ||
1118 | -- Now go ahead and evolve the expression | |
1119 | ||
ca188295 | 1120 | Size.Nod := |
83cce46b | 1121 | Assoc_Multiply (Loc, |
ca188295 | 1122 | Left_Opnd => Size.Nod, |
83cce46b | 1123 | Right_Opnd => |
1124 | Make_Integer_Literal (Loc, Intval => S)); | |
1125 | end if; | |
1126 | ||
1127 | -- Value of the current subscript range is dynamic | |
1128 | ||
1129 | else | |
1130 | -- If the current size value is constant, then here is where we | |
1131 | -- make a transition to dynamic values, which are always stored | |
1132 | -- in storage units, However, we do not want to convert to SU's | |
1133 | -- too soon, consider the case of a packed array of single bits, | |
1134 | -- we want to do the SU conversion after computing the size in | |
1135 | -- this case. | |
1136 | ||
ca188295 | 1137 | if Size.Status = Const then |
83cce46b | 1138 | |
1139 | -- If the current value is a multiple of the storage unit, | |
1140 | -- then most certainly we can do the conversion now, simply | |
1141 | -- by dividing the current value by the storage unit value. | |
1142 | -- If this works, we set SU_Convert_Required to False. | |
1143 | ||
ca188295 | 1144 | if Size.Val mod SSU = 0 then |
1145 | Size := | |
1146 | (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU)); | |
83cce46b | 1147 | SU_Convert_Required := False; |
1148 | ||
5e640318 | 1149 | -- If the current value is a factor of the storage unit, then |
1150 | -- we can use a value of one for the size and reduce the | |
1151 | -- strength of the later division. | |
9dfe12ae | 1152 | |
1153 | elsif SSU mod Size.Val = 0 then | |
1154 | Storage_Divisor := SSU / Size.Val; | |
1155 | Size := (Dynamic, Make_Integer_Literal (Loc, Uint_1)); | |
1156 | SU_Convert_Required := True; | |
1157 | ||
5e640318 | 1158 | -- Otherwise, we go ahead and convert the value in bits, and |
1159 | -- set SU_Convert_Required to True to ensure that the final | |
1160 | -- value is indeed properly converted. | |
83cce46b | 1161 | |
1162 | else | |
ca188295 | 1163 | Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val)); |
83cce46b | 1164 | SU_Convert_Required := True; |
1165 | end if; | |
1166 | end if; | |
1167 | ||
1168 | Discrimify (Lo); | |
1169 | Discrimify (Hi); | |
1170 | ||
1171 | -- Length is hi-lo+1 | |
1172 | ||
1173 | Len := Compute_Length (Lo, Hi); | |
1174 | ||
5e640318 | 1175 | -- If Len isn't a Length attribute, then its range needs to be |
1176 | -- checked a possible Max with zero needs to be computed. | |
83cce46b | 1177 | |
9dfe12ae | 1178 | if Nkind (Len) /= N_Attribute_Reference |
1179 | or else Attribute_Name (Len) /= Name_Length | |
1180 | then | |
1181 | declare | |
1182 | OK : Boolean; | |
1183 | LLo : Uint; | |
1184 | LHi : Uint; | |
83cce46b | 1185 | |
9dfe12ae | 1186 | begin |
1187 | -- Check possible range of Len | |
83cce46b | 1188 | |
9dfe12ae | 1189 | Set_Parent (Len, E); |
1190 | Determine_Range (Len, OK, LLo, LHi); | |
e4bd5d4a | 1191 | |
9dfe12ae | 1192 | Len := Convert_To (Standard_Unsigned, Len); |
83cce46b | 1193 | |
9dfe12ae | 1194 | -- If range definitely flat or superflat, |
1195 | -- result size is zero | |
83cce46b | 1196 | |
9dfe12ae | 1197 | if OK and then LHi <= 0 then |
1198 | Set_Esize (E, Uint_0); | |
1199 | Set_RM_Size (E, Uint_0); | |
1200 | return; | |
1201 | end if; | |
83cce46b | 1202 | |
5e640318 | 1203 | -- If we cannot verify that range cannot be super-flat, we |
1204 | -- need a max with zero, since length cannot be negative. | |
9dfe12ae | 1205 | |
1206 | if not OK or else LLo < 0 then | |
1207 | Len := | |
1208 | Make_Attribute_Reference (Loc, | |
1209 | Prefix => | |
1210 | New_Occurrence_Of (Standard_Unsigned, Loc), | |
1211 | Attribute_Name => Name_Max, | |
1212 | Expressions => New_List ( | |
1213 | Make_Integer_Literal (Loc, 0), | |
1214 | Len)); | |
1215 | end if; | |
1216 | end; | |
1217 | end if; | |
83cce46b | 1218 | |
1219 | -- At this stage, Len has the expression for the length | |
1220 | ||
ca188295 | 1221 | Size.Nod := |
83cce46b | 1222 | Assoc_Multiply (Loc, |
ca188295 | 1223 | Left_Opnd => Size.Nod, |
83cce46b | 1224 | Right_Opnd => Len); |
1225 | end if; | |
1226 | ||
1227 | Next_Index (Indx); | |
1228 | end loop; | |
1229 | ||
5e640318 | 1230 | -- Here after processing all bounds to set sizes. If the value is a |
1231 | -- constant, then it is bits, and the only thing we need to do is to | |
1232 | -- check against explicit given size and do alignment adjust. | |
83cce46b | 1233 | |
ca188295 | 1234 | if Size.Status = Const then |
1235 | Set_And_Check_Static_Size (E, Size.Val, Size.Val); | |
83cce46b | 1236 | Adjust_Esize_Alignment (E); |
1237 | ||
1238 | -- Case where the value is dynamic | |
1239 | ||
1240 | else | |
1241 | -- Do convert from bits to SU's if needed | |
1242 | ||
1243 | if SU_Convert_Required then | |
1244 | ||
9dfe12ae | 1245 | -- The expression required is: |
1246 | -- (Size.Nod + Storage_Divisor - 1) / Storage_Divisor | |
83cce46b | 1247 | |
ca188295 | 1248 | Size.Nod := |
83cce46b | 1249 | Make_Op_Divide (Loc, |
1250 | Left_Opnd => | |
1251 | Make_Op_Add (Loc, | |
ca188295 | 1252 | Left_Opnd => Size.Nod, |
9dfe12ae | 1253 | Right_Opnd => Make_Integer_Literal |
1254 | (Loc, Storage_Divisor - 1)), | |
1255 | Right_Opnd => Make_Integer_Literal (Loc, Storage_Divisor)); | |
1256 | end if; | |
1257 | ||
1258 | -- If the array entity is not declared at the library level and its | |
1259 | -- not nested within a subprogram that is marked for inlining, then | |
1260 | -- we request that the size expression be encapsulated in a function. | |
1261 | -- Since this expression is not needed in most cases, we prefer not | |
1262 | -- to incur the overhead of the computation on calls to the enclosing | |
1263 | -- subprogram except for subprograms that require the size. | |
1264 | ||
1265 | if not Is_Library_Level_Entity (E) then | |
1266 | Make_Size_Function := True; | |
1267 | ||
1268 | declare | |
1269 | Parent_Subp : Entity_Id := Enclosing_Subprogram (E); | |
1270 | ||
1271 | begin | |
1272 | while Present (Parent_Subp) loop | |
1273 | if Is_Inlined (Parent_Subp) then | |
1274 | Make_Size_Function := False; | |
1275 | exit; | |
1276 | end if; | |
1277 | ||
1278 | Parent_Subp := Enclosing_Subprogram (Parent_Subp); | |
1279 | end loop; | |
1280 | end; | |
83cce46b | 1281 | end if; |
1282 | ||
0cafb066 | 1283 | -- Now set the dynamic size (the Value_Size is always the same as the |
1284 | -- Object_Size for arrays whose length is dynamic). | |
83cce46b | 1285 | |
ca188295 | 1286 | -- ??? If Size.Status = Dynamic, Vtyp will not have been set. |
1287 | -- The added initialization sets it to Empty now, but is this | |
1288 | -- correct? | |
1289 | ||
9dfe12ae | 1290 | Set_Esize |
1291 | (E, | |
1292 | SO_Ref_From_Expr | |
1293 | (Size.Nod, Insert_Typ, Vtyp, Make_Func => Make_Size_Function)); | |
83cce46b | 1294 | Set_RM_Size (E, Esize (E)); |
1295 | end if; | |
1296 | end Layout_Array_Type; | |
1297 | ||
4524d1ce | 1298 | ------------------------------------------ |
1299 | -- Compute_Size_Depends_On_Discriminant -- | |
1300 | ------------------------------------------ | |
1301 | ||
1302 | procedure Compute_Size_Depends_On_Discriminant (E : Entity_Id) is | |
1303 | Indx : Node_Id; | |
1304 | Ityp : Entity_Id; | |
1305 | Lo : Node_Id; | |
1306 | Hi : Node_Id; | |
1307 | Res : Boolean := False; | |
0cafb066 | 1308 | |
4524d1ce | 1309 | begin |
1310 | -- Loop to process array indexes | |
1311 | ||
1312 | Indx := First_Index (E); | |
1313 | while Present (Indx) loop | |
1314 | Ityp := Etype (Indx); | |
1315 | ||
1316 | -- If an index of the array is a generic formal type then there is | |
1317 | -- no point in determining a size for the array type. | |
1318 | ||
1319 | if Is_Generic_Type (Ityp) then | |
1320 | return; | |
1321 | end if; | |
1322 | ||
1323 | Lo := Type_Low_Bound (Ityp); | |
1324 | Hi := Type_High_Bound (Ityp); | |
1325 | ||
1326 | if (Nkind (Lo) = N_Identifier | |
0cafb066 | 1327 | and then Ekind (Entity (Lo)) = E_Discriminant) |
1328 | or else | |
1329 | (Nkind (Hi) = N_Identifier | |
1330 | and then Ekind (Entity (Hi)) = E_Discriminant) | |
4524d1ce | 1331 | then |
1332 | Res := True; | |
1333 | end if; | |
1334 | ||
1335 | Next_Index (Indx); | |
1336 | end loop; | |
1337 | ||
1338 | if Res then | |
1339 | Set_Size_Depends_On_Discriminant (E); | |
1340 | end if; | |
1341 | end Compute_Size_Depends_On_Discriminant; | |
1342 | ||
83cce46b | 1343 | ------------------- |
1344 | -- Layout_Object -- | |
1345 | ------------------- | |
1346 | ||
1347 | procedure Layout_Object (E : Entity_Id) is | |
1348 | T : constant Entity_Id := Etype (E); | |
1349 | ||
1350 | begin | |
1351 | -- Nothing to do if backend does layout | |
1352 | ||
1353 | if not Frontend_Layout_On_Target then | |
1354 | return; | |
1355 | end if; | |
1356 | ||
5e640318 | 1357 | -- Set size if not set for object and known for type. Use the RM_Size if |
1358 | -- that is known for the type and Esize is not. | |
83cce46b | 1359 | |
1360 | if Unknown_Esize (E) then | |
1361 | if Known_Esize (T) then | |
1362 | Set_Esize (E, Esize (T)); | |
1363 | ||
1364 | elsif Known_RM_Size (T) then | |
1365 | Set_Esize (E, RM_Size (T)); | |
1366 | end if; | |
1367 | end if; | |
1368 | ||
1369 | -- Set alignment from type if unknown and type alignment known | |
1370 | ||
1371 | if Unknown_Alignment (E) and then Known_Alignment (T) then | |
1372 | Set_Alignment (E, Alignment (T)); | |
1373 | end if; | |
1374 | ||
1375 | -- Make sure size and alignment are consistent | |
1376 | ||
1377 | Adjust_Esize_Alignment (E); | |
1378 | ||
5e640318 | 1379 | -- Final adjustment, if we don't know the alignment, and the Esize was |
1380 | -- not set by an explicit Object_Size attribute clause, then we reset | |
1381 | -- the Esize to unknown, since we really don't know it. | |
83cce46b | 1382 | |
1383 | if Unknown_Alignment (E) | |
1384 | and then not Has_Size_Clause (E) | |
1385 | then | |
1386 | Set_Esize (E, Uint_0); | |
1387 | end if; | |
1388 | end Layout_Object; | |
1389 | ||
1390 | ------------------------ | |
1391 | -- Layout_Record_Type -- | |
1392 | ------------------------ | |
1393 | ||
1394 | procedure Layout_Record_Type (E : Entity_Id) is | |
1395 | Loc : constant Source_Ptr := Sloc (E); | |
1396 | Decl : Node_Id; | |
1397 | ||
1398 | Comp : Entity_Id; | |
9dfe12ae | 1399 | -- Current component being laid out |
83cce46b | 1400 | |
1401 | Prev_Comp : Entity_Id; | |
9dfe12ae | 1402 | -- Previous laid out component |
83cce46b | 1403 | |
1404 | procedure Get_Next_Component_Location | |
1405 | (Prev_Comp : Entity_Id; | |
1406 | Align : Uint; | |
1407 | New_Npos : out SO_Ref; | |
1408 | New_Fbit : out SO_Ref; | |
1409 | New_NPMax : out SO_Ref; | |
1410 | Force_SU : Boolean); | |
1411 | -- Given the previous component in Prev_Comp, which is already laid | |
1412 | -- out, and the alignment of the following component, lays out the | |
1413 | -- following component, and returns its starting position in New_Npos | |
1414 | -- (Normalized_Position value), New_Fbit (Normalized_First_Bit value), | |
1415 | -- and New_NPMax (Normalized_Position_Max value). If Prev_Comp is empty | |
1416 | -- (no previous component is present), then New_Npos, New_Fbit and | |
1417 | -- New_NPMax are all set to zero on return. This procedure is also | |
1418 | -- used to compute the size of a record or variant by giving it the | |
1419 | -- last component, and the record alignment. Force_SU is used to force | |
1420 | -- the new component location to be aligned on a storage unit boundary, | |
1421 | -- even in a packed record, False means that the new position does not | |
1422 | -- need to be bumped to a storage unit boundary, True means a storage | |
1423 | -- unit boundary is always required. | |
1424 | ||
1425 | procedure Layout_Component (Comp : Entity_Id; Prev_Comp : Entity_Id); | |
1426 | -- Lays out component Comp, given Prev_Comp, the previously laid-out | |
1427 | -- component (Prev_Comp = Empty if no components laid out yet). The | |
1428 | -- alignment of the record itself is also updated if needed. Both | |
9dfe12ae | 1429 | -- Comp and Prev_Comp can be either components or discriminants. |
83cce46b | 1430 | |
1431 | procedure Layout_Components | |
1432 | (From : Entity_Id; | |
1433 | To : Entity_Id; | |
1434 | Esiz : out SO_Ref; | |
1435 | RM_Siz : out SO_Ref); | |
1436 | -- This procedure lays out the components of the given component list | |
9dfe12ae | 1437 | -- which contains the components starting with From and ending with To. |
1438 | -- The Next_Entity chain is used to traverse the components. On entry, | |
83cce46b | 1439 | -- Prev_Comp is set to the component preceding the list, so that the |
9dfe12ae | 1440 | -- list is laid out after this component. Prev_Comp is set to Empty if |
1441 | -- the component list is to be laid out starting at the start of the | |
1442 | -- record. On return, the components are all laid out, and Prev_Comp is | |
1443 | -- set to the last laid out component. On return, Esiz is set to the | |
83cce46b | 1444 | -- resulting Object_Size value, which is the length of the record up |
9dfe12ae | 1445 | -- to and including the last laid out entity. For Esiz, the value is |
83cce46b | 1446 | -- adjusted to match the alignment of the record. RM_Siz is similarly |
1447 | -- set to the resulting Value_Size value, which is the same length, but | |
1448 | -- not adjusted to meet the alignment. Note that in the case of variant | |
1449 | -- records, Esiz represents the maximum size. | |
1450 | ||
1451 | procedure Layout_Non_Variant_Record; | |
9dfe12ae | 1452 | -- Procedure called to lay out a non-variant record type or subtype |
83cce46b | 1453 | |
1454 | procedure Layout_Variant_Record; | |
9dfe12ae | 1455 | -- Procedure called to lay out a variant record type. Decl is set to the |
83cce46b | 1456 | -- full type declaration for the variant record. |
1457 | ||
1458 | --------------------------------- | |
1459 | -- Get_Next_Component_Location -- | |
1460 | --------------------------------- | |
1461 | ||
1462 | procedure Get_Next_Component_Location | |
1463 | (Prev_Comp : Entity_Id; | |
1464 | Align : Uint; | |
1465 | New_Npos : out SO_Ref; | |
1466 | New_Fbit : out SO_Ref; | |
1467 | New_NPMax : out SO_Ref; | |
1468 | Force_SU : Boolean) | |
1469 | is | |
1470 | begin | |
1471 | -- No previous component, return zero position | |
1472 | ||
1473 | if No (Prev_Comp) then | |
1474 | New_Npos := Uint_0; | |
1475 | New_Fbit := Uint_0; | |
1476 | New_NPMax := Uint_0; | |
1477 | return; | |
1478 | end if; | |
1479 | ||
1480 | -- Here we have a previous component | |
1481 | ||
1482 | declare | |
1483 | Loc : constant Source_Ptr := Sloc (Prev_Comp); | |
1484 | ||
1485 | Old_Npos : constant SO_Ref := Normalized_Position (Prev_Comp); | |
1486 | Old_Fbit : constant SO_Ref := Normalized_First_Bit (Prev_Comp); | |
1487 | Old_NPMax : constant SO_Ref := Normalized_Position_Max (Prev_Comp); | |
1488 | Old_Esiz : constant SO_Ref := Esize (Prev_Comp); | |
1489 | ||
1490 | Old_Maxsz : Node_Id; | |
1491 | -- Expression representing maximum size of previous component | |
1492 | ||
1493 | begin | |
1494 | -- Case where previous field had a dynamic size | |
1495 | ||
1496 | if Is_Dynamic_SO_Ref (Esize (Prev_Comp)) then | |
1497 | ||
1498 | -- If the previous field had a dynamic length, then it is | |
1499 | -- required to occupy an integral number of storage units, | |
1500 | -- and start on a storage unit boundary. This means that | |
1501 | -- the Normalized_First_Bit value is zero in the previous | |
1502 | -- component, and the new value is also set to zero. | |
1503 | ||
1504 | New_Fbit := Uint_0; | |
1505 | ||
1506 | -- In this case, the new position is given by an expression | |
1507 | -- that is the sum of old normalized position and old size. | |
1508 | ||
1509 | New_Npos := | |
1510 | SO_Ref_From_Expr | |
1511 | (Assoc_Add (Loc, | |
9dfe12ae | 1512 | Left_Opnd => |
1513 | Expr_From_SO_Ref (Loc, Old_Npos), | |
1514 | Right_Opnd => | |
1515 | Expr_From_SO_Ref (Loc, Old_Esiz, Prev_Comp)), | |
83cce46b | 1516 | Ins_Type => E, |
1517 | Vtype => E); | |
1518 | ||
1519 | -- Get maximum size of previous component | |
1520 | ||
1521 | if Size_Depends_On_Discriminant (Etype (Prev_Comp)) then | |
35c57fc7 | 1522 | Old_Maxsz := Get_Max_SU_Size (Etype (Prev_Comp)); |
83cce46b | 1523 | else |
9dfe12ae | 1524 | Old_Maxsz := Expr_From_SO_Ref (Loc, Old_Esiz, Prev_Comp); |
83cce46b | 1525 | end if; |
1526 | ||
1527 | -- Now we can compute the new max position. If the max size | |
1528 | -- is static and the old position is static, then we can | |
1529 | -- compute the new position statically. | |
1530 | ||
1531 | if Nkind (Old_Maxsz) = N_Integer_Literal | |
1532 | and then Known_Static_Normalized_Position_Max (Prev_Comp) | |
1533 | then | |
1534 | New_NPMax := Old_NPMax + Intval (Old_Maxsz); | |
1535 | ||
1536 | -- Otherwise new max position is dynamic | |
1537 | ||
1538 | else | |
1539 | New_NPMax := | |
1540 | SO_Ref_From_Expr | |
1541 | (Assoc_Add (Loc, | |
1542 | Left_Opnd => Expr_From_SO_Ref (Loc, Old_NPMax), | |
1543 | Right_Opnd => Old_Maxsz), | |
1544 | Ins_Type => E, | |
1545 | Vtype => E); | |
1546 | end if; | |
1547 | ||
1548 | -- Previous field has known static Esize | |
1549 | ||
1550 | else | |
1551 | New_Fbit := Old_Fbit + Old_Esiz; | |
1552 | ||
1553 | -- Bump New_Fbit to storage unit boundary if required | |
1554 | ||
1555 | if New_Fbit /= 0 and then Force_SU then | |
1556 | New_Fbit := (New_Fbit + SSU - 1) / SSU * SSU; | |
1557 | end if; | |
1558 | ||
5e640318 | 1559 | -- If old normalized position is static, we can go ahead and |
1560 | -- compute the new normalized position directly. | |
83cce46b | 1561 | |
1562 | if Known_Static_Normalized_Position (Prev_Comp) then | |
1563 | New_Npos := Old_Npos; | |
1564 | ||
1565 | if New_Fbit >= SSU then | |
1566 | New_Npos := New_Npos + New_Fbit / SSU; | |
1567 | New_Fbit := New_Fbit mod SSU; | |
1568 | end if; | |
1569 | ||
1570 | -- Bump alignment if stricter than prev | |
1571 | ||
9dfe12ae | 1572 | if Align > Alignment (Etype (Prev_Comp)) then |
83cce46b | 1573 | New_Npos := (New_Npos + Align - 1) / Align * Align; |
1574 | end if; | |
1575 | ||
1576 | -- The max position is always equal to the position if | |
1577 | -- the latter is static, since arrays depending on the | |
1578 | -- values of discriminants never have static sizes. | |
1579 | ||
1580 | New_NPMax := New_Npos; | |
1581 | return; | |
1582 | ||
1583 | -- Case of old normalized position is dynamic | |
1584 | ||
1585 | else | |
1586 | -- If new bit position is within the current storage unit, | |
1587 | -- we can just copy the old position as the result position | |
1588 | -- (we have already set the new first bit value). | |
1589 | ||
1590 | if New_Fbit < SSU then | |
1591 | New_Npos := Old_Npos; | |
1592 | New_NPMax := Old_NPMax; | |
1593 | ||
1594 | -- If new bit position is past the current storage unit, we | |
1595 | -- need to generate a new dynamic value for the position | |
1596 | -- ??? need to deal with alignment | |
1597 | ||
1598 | else | |
1599 | New_Npos := | |
1600 | SO_Ref_From_Expr | |
1601 | (Assoc_Add (Loc, | |
1602 | Left_Opnd => Expr_From_SO_Ref (Loc, Old_Npos), | |
1603 | Right_Opnd => | |
1604 | Make_Integer_Literal (Loc, | |
1605 | Intval => New_Fbit / SSU)), | |
1606 | Ins_Type => E, | |
1607 | Vtype => E); | |
1608 | ||
1609 | New_NPMax := | |
1610 | SO_Ref_From_Expr | |
1611 | (Assoc_Add (Loc, | |
1612 | Left_Opnd => Expr_From_SO_Ref (Loc, Old_NPMax), | |
1613 | Right_Opnd => | |
1614 | Make_Integer_Literal (Loc, | |
1615 | Intval => New_Fbit / SSU)), | |
1616 | Ins_Type => E, | |
1617 | Vtype => E); | |
1618 | New_Fbit := New_Fbit mod SSU; | |
1619 | end if; | |
1620 | end if; | |
1621 | end if; | |
1622 | end; | |
1623 | end Get_Next_Component_Location; | |
1624 | ||
1625 | ---------------------- | |
1626 | -- Layout_Component -- | |
1627 | ---------------------- | |
1628 | ||
1629 | procedure Layout_Component (Comp : Entity_Id; Prev_Comp : Entity_Id) is | |
1630 | Ctyp : constant Entity_Id := Etype (Comp); | |
d1cf00c6 | 1631 | ORC : constant Entity_Id := Original_Record_Component (Comp); |
83cce46b | 1632 | Npos : SO_Ref; |
1633 | Fbit : SO_Ref; | |
1634 | NPMax : SO_Ref; | |
1635 | Forc : Boolean; | |
1636 | ||
1637 | begin | |
d1cf00c6 | 1638 | -- Increase alignment of record if necessary. Note that we do not |
1639 | -- do this for packed records, which have an alignment of one by | |
1640 | -- default, or for records for which an explicit alignment was | |
1641 | -- specified with an alignment clause. | |
1642 | ||
1643 | if not Is_Packed (E) | |
1644 | and then not Has_Alignment_Clause (E) | |
1645 | and then Alignment (Ctyp) > Alignment (E) | |
1646 | then | |
1647 | Set_Alignment (E, Alignment (Ctyp)); | |
1648 | end if; | |
1649 | ||
1650 | -- If original component set, then use same layout | |
1651 | ||
1652 | if Present (ORC) and then ORC /= Comp then | |
1653 | Set_Normalized_Position (Comp, Normalized_Position (ORC)); | |
1654 | Set_Normalized_First_Bit (Comp, Normalized_First_Bit (ORC)); | |
1655 | Set_Normalized_Position_Max (Comp, Normalized_Position_Max (ORC)); | |
1656 | Set_Component_Bit_Offset (Comp, Component_Bit_Offset (ORC)); | |
1657 | Set_Esize (Comp, Esize (ORC)); | |
1658 | return; | |
1659 | end if; | |
1660 | ||
83cce46b | 1661 | -- Parent field is always at start of record, this will overlap |
1662 | -- the actual fields that are part of the parent, and that's fine | |
1663 | ||
1664 | if Chars (Comp) = Name_uParent then | |
1665 | Set_Normalized_Position (Comp, Uint_0); | |
1666 | Set_Normalized_First_Bit (Comp, Uint_0); | |
1667 | Set_Normalized_Position_Max (Comp, Uint_0); | |
1668 | Set_Component_Bit_Offset (Comp, Uint_0); | |
1669 | Set_Esize (Comp, Esize (Ctyp)); | |
1670 | return; | |
1671 | end if; | |
1672 | ||
5e640318 | 1673 | -- Check case of type of component has a scope of the record we are |
1674 | -- laying out. When this happens, the type in question is an Itype | |
1675 | -- that has not yet been laid out (that's because such types do not | |
1676 | -- get frozen in the normal manner, because there is no place for | |
1677 | -- the freeze nodes). | |
83cce46b | 1678 | |
1679 | if Scope (Ctyp) = E then | |
1680 | Layout_Type (Ctyp); | |
1681 | end if; | |
1682 | ||
83cce46b | 1683 | -- If component already laid out, then we are done |
1684 | ||
1685 | if Known_Normalized_Position (Comp) then | |
1686 | return; | |
1687 | end if; | |
1688 | ||
1689 | -- Set size of component from type. We use the Esize except in a | |
5e640318 | 1690 | -- packed record, where we use the RM_Size (since that is what the |
1691 | -- RM_Size value, as distinct from the Object_Size is useful for!) | |
83cce46b | 1692 | |
1693 | if Is_Packed (E) then | |
1694 | Set_Esize (Comp, RM_Size (Ctyp)); | |
1695 | else | |
1696 | Set_Esize (Comp, Esize (Ctyp)); | |
1697 | end if; | |
1698 | ||
1699 | -- Compute the component position from the previous one. See if | |
1700 | -- current component requires being on a storage unit boundary. | |
1701 | ||
1702 | -- If record is not packed, we always go to a storage unit boundary | |
1703 | ||
1704 | if not Is_Packed (E) then | |
1705 | Forc := True; | |
1706 | ||
1707 | -- Packed cases | |
1708 | ||
1709 | else | |
1710 | -- Elementary types do not need SU boundary in packed record | |
1711 | ||
1712 | if Is_Elementary_Type (Ctyp) then | |
1713 | Forc := False; | |
1714 | ||
1715 | -- Packed array types with a modular packed array type do not | |
1716 | -- force a storage unit boundary (since the code generation | |
1717 | -- treats these as equivalent to the underlying modular type), | |
1718 | ||
1719 | elsif Is_Array_Type (Ctyp) | |
1720 | and then Is_Bit_Packed_Array (Ctyp) | |
1721 | and then Is_Modular_Integer_Type (Packed_Array_Type (Ctyp)) | |
1722 | then | |
1723 | Forc := False; | |
1724 | ||
1725 | -- Record types with known length less than or equal to the length | |
1726 | -- of long long integer can also be unaligned, since they can be | |
1727 | -- treated as scalars. | |
1728 | ||
1729 | elsif Is_Record_Type (Ctyp) | |
1730 | and then not Is_Dynamic_SO_Ref (Esize (Ctyp)) | |
1731 | and then Esize (Ctyp) <= Esize (Standard_Long_Long_Integer) | |
1732 | then | |
1733 | Forc := False; | |
1734 | ||
1735 | -- All other cases force a storage unit boundary, even when packed | |
1736 | ||
1737 | else | |
1738 | Forc := True; | |
1739 | end if; | |
1740 | end if; | |
1741 | ||
1742 | -- Now get the next component location | |
1743 | ||
1744 | Get_Next_Component_Location | |
1745 | (Prev_Comp, Alignment (Ctyp), Npos, Fbit, NPMax, Forc); | |
1746 | Set_Normalized_Position (Comp, Npos); | |
1747 | Set_Normalized_First_Bit (Comp, Fbit); | |
1748 | Set_Normalized_Position_Max (Comp, NPMax); | |
1749 | ||
1750 | -- Set Component_Bit_Offset in the static case | |
1751 | ||
1752 | if Known_Static_Normalized_Position (Comp) | |
1753 | and then Known_Normalized_First_Bit (Comp) | |
1754 | then | |
1755 | Set_Component_Bit_Offset (Comp, SSU * Npos + Fbit); | |
1756 | end if; | |
1757 | end Layout_Component; | |
1758 | ||
1759 | ----------------------- | |
1760 | -- Layout_Components -- | |
1761 | ----------------------- | |
1762 | ||
1763 | procedure Layout_Components | |
1764 | (From : Entity_Id; | |
1765 | To : Entity_Id; | |
1766 | Esiz : out SO_Ref; | |
1767 | RM_Siz : out SO_Ref) | |
1768 | is | |
1769 | End_Npos : SO_Ref; | |
1770 | End_Fbit : SO_Ref; | |
1771 | End_NPMax : SO_Ref; | |
1772 | ||
1773 | begin | |
9dfe12ae | 1774 | -- Only lay out components if there are some to lay out! |
83cce46b | 1775 | |
1776 | if Present (From) then | |
1777 | ||
9dfe12ae | 1778 | -- Lay out components with no component clauses |
83cce46b | 1779 | |
1780 | Comp := From; | |
1781 | loop | |
9dfe12ae | 1782 | if Ekind (Comp) = E_Component |
1783 | or else Ekind (Comp) = E_Discriminant | |
83cce46b | 1784 | then |
9dfe12ae | 1785 | -- The compatibility of component clauses with composite |
1786 | -- types isn't checked in Sem_Ch13, so we check it here. | |
1787 | ||
1788 | if Present (Component_Clause (Comp)) then | |
1789 | if Is_Composite_Type (Etype (Comp)) | |
1790 | and then Esize (Comp) < RM_Size (Etype (Comp)) | |
1791 | then | |
1792 | Error_Msg_Uint_1 := RM_Size (Etype (Comp)); | |
1793 | Error_Msg_NE | |
1794 | ("size for & too small, minimum allowed is ^", | |
1795 | Component_Clause (Comp), | |
1796 | Comp); | |
1797 | end if; | |
1798 | ||
1799 | else | |
1800 | Layout_Component (Comp, Prev_Comp); | |
1801 | Prev_Comp := Comp; | |
1802 | end if; | |
83cce46b | 1803 | end if; |
1804 | ||
1805 | exit when Comp = To; | |
1806 | Next_Entity (Comp); | |
1807 | end loop; | |
1808 | end if; | |
1809 | ||
1810 | -- Set size fields, both are zero if no components | |
1811 | ||
1812 | if No (Prev_Comp) then | |
1813 | Esiz := Uint_0; | |
1814 | RM_Siz := Uint_0; | |
1815 | ||
d1cf00c6 | 1816 | -- If record subtype with non-static discriminants, then we don't |
1817 | -- know which variant will be the one which gets chosen. We don't | |
1818 | -- just want to set the maximum size from the base, because the | |
1819 | -- size should depend on the particular variant. | |
1820 | ||
1821 | -- What we do is to use the RM_Size of the base type, which has | |
1822 | -- the necessary conditional computation of the size, using the | |
1823 | -- size information for the particular variant chosen. Records | |
1824 | -- with default discriminants for example have an Esize that is | |
1825 | -- set to the maximum of all variants, but that's not what we | |
1826 | -- want for a constrained subtype. | |
1827 | ||
1828 | elsif Ekind (E) = E_Record_Subtype | |
1829 | and then not Has_Static_Discriminants (E) | |
1830 | then | |
1831 | declare | |
1832 | BT : constant Node_Id := Base_Type (E); | |
1833 | begin | |
1834 | Esiz := RM_Size (BT); | |
1835 | RM_Siz := RM_Size (BT); | |
1836 | Set_Alignment (E, Alignment (BT)); | |
1837 | end; | |
1838 | ||
83cce46b | 1839 | else |
d1cf00c6 | 1840 | -- First the object size, for which we align past the last field |
1841 | -- to the alignment of the record (the object size is required to | |
1842 | -- be a multiple of the alignment). | |
83cce46b | 1843 | |
1844 | Get_Next_Component_Location | |
1845 | (Prev_Comp, | |
1846 | Alignment (E), | |
1847 | End_Npos, | |
1848 | End_Fbit, | |
1849 | End_NPMax, | |
1850 | Force_SU => True); | |
1851 | ||
1852 | -- If the resulting normalized position is a dynamic reference, | |
d1cf00c6 | 1853 | -- then the size is dynamic, and is stored in storage units. In |
1854 | -- this case, we set the RM_Size to the same value, it is simply | |
1855 | -- not worth distinguishing Esize and RM_Size values in the | |
1856 | -- dynamic case, since the RM has nothing to say about them. | |
83cce46b | 1857 | |
1858 | -- Note that a size cannot have been given in this case, since | |
1859 | -- size specifications cannot be given for variable length types. | |
1860 | ||
1861 | declare | |
1862 | Align : constant Uint := Alignment (E); | |
1863 | ||
1864 | begin | |
1865 | if Is_Dynamic_SO_Ref (End_Npos) then | |
1866 | RM_Siz := End_Npos; | |
1867 | ||
d1cf00c6 | 1868 | -- Set the Object_Size allowing for the alignment. In the |
1869 | -- dynamic case, we must do the actual runtime computation. | |
1870 | -- We can skip this in the non-packed record case if the | |
1871 | -- last component has a smaller alignment than the overall | |
1872 | -- record alignment. | |
83cce46b | 1873 | |
1874 | if Is_Dynamic_SO_Ref (End_NPMax) then | |
1875 | Esiz := End_NPMax; | |
1876 | ||
1877 | if Is_Packed (E) | |
9dfe12ae | 1878 | or else Alignment (Etype (Prev_Comp)) < Align |
83cce46b | 1879 | then |
d1cf00c6 | 1880 | -- The expression we build is: |
1881 | -- (expr + align - 1) / align * align | |
83cce46b | 1882 | |
1883 | Esiz := | |
1884 | SO_Ref_From_Expr | |
1885 | (Expr => | |
1886 | Make_Op_Multiply (Loc, | |
1887 | Left_Opnd => | |
1888 | Make_Op_Divide (Loc, | |
1889 | Left_Opnd => | |
1890 | Make_Op_Add (Loc, | |
1891 | Left_Opnd => | |
1892 | Expr_From_SO_Ref (Loc, Esiz), | |
1893 | Right_Opnd => | |
1894 | Make_Integer_Literal (Loc, | |
1895 | Intval => Align - 1)), | |
1896 | Right_Opnd => | |
1897 | Make_Integer_Literal (Loc, Align)), | |
1898 | Right_Opnd => | |
1899 | Make_Integer_Literal (Loc, Align)), | |
1900 | Ins_Type => E, | |
1901 | Vtype => E); | |
1902 | end if; | |
1903 | ||
1904 | -- Here Esiz is static, so we can adjust the alignment | |
1905 | -- directly go give the required aligned value. | |
1906 | ||
1907 | else | |
1908 | Esiz := (End_NPMax + Align - 1) / Align * Align * SSU; | |
1909 | end if; | |
1910 | ||
1911 | -- Case where computed size is static | |
1912 | ||
1913 | else | |
1914 | -- The ending size was computed in Npos in storage units, | |
1915 | -- but the actual size is stored in bits, so adjust | |
1916 | -- accordingly. We also adjust the size to match the | |
1917 | -- alignment here. | |
1918 | ||
d1cf00c6 | 1919 | Esiz := (End_NPMax + Align - 1) / Align * Align * SSU; |
83cce46b | 1920 | |
1921 | -- Compute the resulting Value_Size (RM_Size). For this | |
1922 | -- purpose we do not force alignment of the record or | |
1923 | -- storage size alignment of the result. | |
1924 | ||
1925 | Get_Next_Component_Location | |
1926 | (Prev_Comp, | |
1927 | Uint_0, | |
1928 | End_Npos, | |
1929 | End_Fbit, | |
1930 | End_NPMax, | |
1931 | Force_SU => False); | |
1932 | ||
1933 | RM_Siz := End_Npos * SSU + End_Fbit; | |
1934 | Set_And_Check_Static_Size (E, Esiz, RM_Siz); | |
1935 | end if; | |
1936 | end; | |
1937 | end if; | |
1938 | end Layout_Components; | |
1939 | ||
1940 | ------------------------------- | |
1941 | -- Layout_Non_Variant_Record -- | |
1942 | ------------------------------- | |
1943 | ||
1944 | procedure Layout_Non_Variant_Record is | |
1945 | Esiz : SO_Ref; | |
1946 | RM_Siz : SO_Ref; | |
83cce46b | 1947 | begin |
1948 | Layout_Components (First_Entity (E), Last_Entity (E), Esiz, RM_Siz); | |
1949 | Set_Esize (E, Esiz); | |
1950 | Set_RM_Size (E, RM_Siz); | |
1951 | end Layout_Non_Variant_Record; | |
1952 | ||
1953 | --------------------------- | |
1954 | -- Layout_Variant_Record -- | |
1955 | --------------------------- | |
1956 | ||
1957 | procedure Layout_Variant_Record is | |
d1cf00c6 | 1958 | Tdef : constant Node_Id := Type_Definition (Decl); |
1959 | First_Discr : Entity_Id; | |
1960 | Last_Discr : Entity_Id; | |
1961 | Esiz : SO_Ref; | |
a13923ff | 1962 | |
1963 | RM_Siz : SO_Ref; | |
1964 | pragma Warnings (Off, SO_Ref); | |
83cce46b | 1965 | |
1966 | RM_Siz_Expr : Node_Id := Empty; | |
92f1631f | 1967 | -- Expression for the evolving RM_Siz value. This is typically an if |
1968 | -- expression which involves tests of discriminant values that are | |
1969 | -- formed as references to the entity V. At the end of scanning all | |
1970 | -- the components, a suitable function is constructed in which V is | |
1971 | -- the parameter. | |
83cce46b | 1972 | |
1973 | ----------------------- | |
1974 | -- Local Subprograms -- | |
1975 | ----------------------- | |
1976 | ||
1977 | procedure Layout_Component_List | |
1978 | (Clist : Node_Id; | |
1979 | Esiz : out SO_Ref; | |
1980 | RM_Siz_Expr : out Node_Id); | |
5e640318 | 1981 | -- Recursive procedure, called to lay out one component list Esiz |
1982 | -- and RM_Siz_Expr are set to the Object_Size and Value_Size values | |
1983 | -- respectively representing the record size up to and including the | |
1984 | -- last component in the component list (including any variants in | |
1985 | -- this component list). RM_Siz_Expr is returned as an expression | |
1986 | -- which may in the general case involve some references to the | |
1987 | -- discriminants of the current record value, referenced by selecting | |
1988 | -- from the entity V. | |
83cce46b | 1989 | |
1990 | --------------------------- | |
1991 | -- Layout_Component_List -- | |
1992 | --------------------------- | |
1993 | ||
1994 | procedure Layout_Component_List | |
1995 | (Clist : Node_Id; | |
1996 | Esiz : out SO_Ref; | |
1997 | RM_Siz_Expr : out Node_Id) | |
1998 | is | |
1999 | Citems : constant List_Id := Component_Items (Clist); | |
2000 | Vpart : constant Node_Id := Variant_Part (Clist); | |
2001 | Prv : Node_Id; | |
2002 | Var : Node_Id; | |
2003 | RM_Siz : Uint; | |
2004 | RMS_Ent : Entity_Id; | |
2005 | ||
2006 | begin | |
2007 | if Is_Non_Empty_List (Citems) then | |
2008 | Layout_Components | |
2009 | (From => Defining_Identifier (First (Citems)), | |
2010 | To => Defining_Identifier (Last (Citems)), | |
2011 | Esiz => Esiz, | |
2012 | RM_Siz => RM_Siz); | |
2013 | else | |
2014 | Layout_Components (Empty, Empty, Esiz, RM_Siz); | |
2015 | end if; | |
2016 | ||
2017 | -- Case where no variants are present in the component list | |
2018 | ||
2019 | if No (Vpart) then | |
2020 | ||
2021 | -- The Esiz value has been correctly set by the call to | |
2022 | -- Layout_Components, so there is nothing more to be done. | |
2023 | ||
2024 | -- For RM_Siz, we have an SO_Ref value, which we must convert | |
2025 | -- to an appropriate expression. | |
2026 | ||
2027 | if Is_Static_SO_Ref (RM_Siz) then | |
2028 | RM_Siz_Expr := | |
2029 | Make_Integer_Literal (Loc, | |
d1cf00c6 | 2030 | Intval => RM_Siz); |
83cce46b | 2031 | |
2032 | else | |
2033 | RMS_Ent := Get_Dynamic_SO_Entity (RM_Siz); | |
2034 | ||
5e640318 | 2035 | -- If the size is represented by a function, then we create |
2036 | -- an appropriate function call using V as the parameter to | |
2037 | -- the call. | |
83cce46b | 2038 | |
2039 | if Is_Discrim_SO_Function (RMS_Ent) then | |
2040 | RM_Siz_Expr := | |
2041 | Make_Function_Call (Loc, | |
2042 | Name => New_Occurrence_Of (RMS_Ent, Loc), | |
2043 | Parameter_Associations => New_List ( | |
55868293 | 2044 | Make_Identifier (Loc, Vname))); |
83cce46b | 2045 | |
2046 | -- If the size is represented by a constant, then the | |
2047 | -- expression we want is a reference to this constant | |
2048 | ||
2049 | else | |
2050 | RM_Siz_Expr := New_Occurrence_Of (RMS_Ent, Loc); | |
2051 | end if; | |
2052 | end if; | |
2053 | ||
2054 | -- Case where variants are present in this component list | |
2055 | ||
2056 | else | |
2057 | declare | |
8b20af99 | 2058 | EsizV : SO_Ref; |
2059 | RM_SizV : Node_Id; | |
2060 | Dchoice : Node_Id; | |
2061 | Discrim : Node_Id; | |
2062 | Dtest : Node_Id; | |
2063 | D_List : List_Id; | |
2064 | D_Entity : Entity_Id; | |
83cce46b | 2065 | |
2066 | begin | |
2067 | RM_Siz_Expr := Empty; | |
2068 | Prv := Prev_Comp; | |
2069 | ||
2070 | Var := Last (Variants (Vpart)); | |
2071 | while Present (Var) loop | |
2072 | Prev_Comp := Prv; | |
2073 | Layout_Component_List | |
2074 | (Component_List (Var), EsizV, RM_SizV); | |
2075 | ||
2076 | -- Set the Object_Size. If this is the first variant, | |
2077 | -- we just set the size of this first variant. | |
2078 | ||
2079 | if Var = Last (Variants (Vpart)) then | |
2080 | Esiz := EsizV; | |
2081 | ||
2082 | -- Otherwise the Object_Size is formed as a maximum | |
2083 | -- of Esiz so far from previous variants, and the new | |
2084 | -- Esiz value from the variant we just processed. | |
2085 | ||
2086 | -- If both values are static, we can just compute the | |
2087 | -- maximum directly to save building junk nodes. | |
2088 | ||
2089 | elsif not Is_Dynamic_SO_Ref (Esiz) | |
2090 | and then not Is_Dynamic_SO_Ref (EsizV) | |
2091 | then | |
2092 | Esiz := UI_Max (Esiz, EsizV); | |
2093 | ||
2094 | -- If either value is dynamic, then we have to generate | |
2095 | -- an appropriate Standard_Unsigned'Max attribute call. | |
d1cf00c6 | 2096 | -- If one of the values is static then it needs to be |
2097 | -- converted from bits to storage units to be compatible | |
2098 | -- with the dynamic value. | |
83cce46b | 2099 | |
2100 | else | |
d1cf00c6 | 2101 | if Is_Static_SO_Ref (Esiz) then |
2102 | Esiz := (Esiz + SSU - 1) / SSU; | |
2103 | end if; | |
2104 | ||
2105 | if Is_Static_SO_Ref (EsizV) then | |
2106 | EsizV := (EsizV + SSU - 1) / SSU; | |
2107 | end if; | |
2108 | ||
83cce46b | 2109 | Esiz := |
2110 | SO_Ref_From_Expr | |
2111 | (Make_Attribute_Reference (Loc, | |
2112 | Attribute_Name => Name_Max, | |
2113 | Prefix => | |
2114 | New_Occurrence_Of (Standard_Unsigned, Loc), | |
2115 | Expressions => New_List ( | |
2116 | Expr_From_SO_Ref (Loc, Esiz), | |
2117 | Expr_From_SO_Ref (Loc, EsizV))), | |
2118 | Ins_Type => E, | |
2119 | Vtype => E); | |
2120 | end if; | |
2121 | ||
2122 | -- Now deal with Value_Size (RM_Siz). We are aiming at | |
2123 | -- an expression that looks like: | |
2124 | ||
2125 | -- if xxDx (V.disc) then rmsiz1 | |
2126 | -- else if xxDx (V.disc) then rmsiz2 | |
2127 | -- else ... | |
2128 | ||
2129 | -- Where rmsiz1, rmsiz2... are the RM_Siz values for the | |
2130 | -- individual variants, and xxDx are the discriminant | |
2131 | -- checking functions generated for the variant type. | |
2132 | ||
5e640318 | 2133 | -- If this is the first variant, we simply set the result |
2134 | -- as the expression. Note that this takes care of the | |
2135 | -- others case. | |
83cce46b | 2136 | |
2137 | if No (RM_Siz_Expr) then | |
a60794e6 | 2138 | |
2139 | -- If this is the only variant and the size is a | |
2140 | -- literal, then use bit size as is, otherwise convert | |
2141 | -- to storage units and continue to the next variant. | |
2142 | ||
2143 | if No (Prev (Var)) | |
2144 | and then Nkind (RM_SizV) = N_Integer_Literal | |
2145 | then | |
2146 | RM_Siz_Expr := RM_SizV; | |
2147 | else | |
2148 | RM_Siz_Expr := Bits_To_SU (RM_SizV); | |
2149 | end if; | |
83cce46b | 2150 | |
2151 | -- Otherwise construct the appropriate test | |
2152 | ||
2153 | else | |
83cce46b | 2154 | -- The test to be used in general is a call to the |
2155 | -- discriminant checking function. However, it is | |
2156 | -- definitely worth special casing the very common | |
2157 | -- case where a single value is involved. | |
2158 | ||
2159 | Dchoice := First (Discrete_Choices (Var)); | |
2160 | ||
2161 | if No (Next (Dchoice)) | |
2162 | and then Nkind (Dchoice) /= N_Range | |
2163 | then | |
8b20af99 | 2164 | -- Discriminant to be tested |
2165 | ||
2166 | Discrim := | |
2167 | Make_Selected_Component (Loc, | |
2168 | Prefix => | |
55868293 | 2169 | Make_Identifier (Loc, Vname), |
8b20af99 | 2170 | Selector_Name => |
2171 | New_Occurrence_Of | |
2172 | (Entity (Name (Vpart)), Loc)); | |
2173 | ||
83cce46b | 2174 | Dtest := |
2175 | Make_Op_Eq (Loc, | |
2176 | Left_Opnd => Discrim, | |
2177 | Right_Opnd => New_Copy (Dchoice)); | |
2178 | ||
9dfe12ae | 2179 | -- Generate a call to the discriminant-checking |
2180 | -- function for the variant. Note that the result | |
2181 | -- has to be complemented since the function returns | |
2182 | -- False when the passed discriminant value matches. | |
2183 | ||
83cce46b | 2184 | else |
8b20af99 | 2185 | -- The checking function takes all of the type's |
2186 | -- discriminants as parameters, so a list of all | |
2187 | -- the selected discriminants must be constructed. | |
2188 | ||
2189 | D_List := New_List; | |
2190 | D_Entity := First_Discriminant (E); | |
2191 | while Present (D_Entity) loop | |
2192 | Append ( | |
2193 | Make_Selected_Component (Loc, | |
2194 | Prefix => | |
55868293 | 2195 | Make_Identifier (Loc, Vname), |
8b20af99 | 2196 | Selector_Name => |
55868293 | 2197 | New_Occurrence_Of (D_Entity, Loc)), |
8b20af99 | 2198 | D_List); |
2199 | ||
2200 | D_Entity := Next_Discriminant (D_Entity); | |
2201 | end loop; | |
2202 | ||
83cce46b | 2203 | Dtest := |
9dfe12ae | 2204 | Make_Op_Not (Loc, |
2205 | Right_Opnd => | |
2206 | Make_Function_Call (Loc, | |
2207 | Name => | |
2208 | New_Occurrence_Of | |
2209 | (Dcheck_Function (Var), Loc), | |
2210 | Parameter_Associations => | |
8b20af99 | 2211 | D_List)); |
83cce46b | 2212 | end if; |
2213 | ||
2214 | RM_Siz_Expr := | |
92f1631f | 2215 | Make_If_Expression (Loc, |
83cce46b | 2216 | Expressions => |
9dfe12ae | 2217 | New_List |
2218 | (Dtest, Bits_To_SU (RM_SizV), RM_Siz_Expr)); | |
83cce46b | 2219 | end if; |
2220 | ||
2221 | Prev (Var); | |
2222 | end loop; | |
2223 | end; | |
2224 | end if; | |
2225 | end Layout_Component_List; | |
2226 | ||
2227 | -- Start of processing for Layout_Variant_Record | |
2228 | ||
2229 | begin | |
2230 | -- We need the discriminant checking functions, since we generate | |
2231 | -- calls to these functions for the RM_Size expression, so make | |
2232 | -- sure that these functions have been constructed in time. | |
2233 | ||
2234 | Build_Discr_Checking_Funcs (Decl); | |
2235 | ||
9dfe12ae | 2236 | -- Lay out the discriminants |
83cce46b | 2237 | |
d1cf00c6 | 2238 | First_Discr := First_Discriminant (E); |
2239 | Last_Discr := First_Discr; | |
2240 | while Present (Next_Discriminant (Last_Discr)) loop | |
2241 | Next_Discriminant (Last_Discr); | |
2242 | end loop; | |
2243 | ||
83cce46b | 2244 | Layout_Components |
d1cf00c6 | 2245 | (From => First_Discr, |
2246 | To => Last_Discr, | |
83cce46b | 2247 | Esiz => Esiz, |
2248 | RM_Siz => RM_Siz); | |
2249 | ||
9dfe12ae | 2250 | -- Lay out the main component list (this will make recursive calls |
2251 | -- to lay out all component lists nested within variants). | |
83cce46b | 2252 | |
2253 | Layout_Component_List (Component_List (Tdef), Esiz, RM_Siz_Expr); | |
d1cf00c6 | 2254 | Set_Esize (E, Esiz); |
83cce46b | 2255 | |
2256 | -- If the RM_Size is a literal, set its value | |
2257 | ||
2258 | if Nkind (RM_Siz_Expr) = N_Integer_Literal then | |
2259 | Set_RM_Size (E, Intval (RM_Siz_Expr)); | |
2260 | ||
2261 | -- Otherwise we construct a dynamic SO_Ref | |
2262 | ||
2263 | else | |
2264 | Set_RM_Size (E, | |
2265 | SO_Ref_From_Expr | |
2266 | (RM_Siz_Expr, | |
2267 | Ins_Type => E, | |
2268 | Vtype => E)); | |
2269 | end if; | |
2270 | end Layout_Variant_Record; | |
2271 | ||
2272 | -- Start of processing for Layout_Record_Type | |
2273 | ||
2274 | begin | |
2275 | -- If this is a cloned subtype, just copy the size fields from the | |
2276 | -- original, nothing else needs to be done in this case, since the | |
2277 | -- components themselves are all shared. | |
2278 | ||
2279 | if (Ekind (E) = E_Record_Subtype | |
d1cf00c6 | 2280 | or else |
2281 | Ekind (E) = E_Class_Wide_Subtype) | |
83cce46b | 2282 | and then Present (Cloned_Subtype (E)) |
2283 | then | |
2284 | Set_Esize (E, Esize (Cloned_Subtype (E))); | |
2285 | Set_RM_Size (E, RM_Size (Cloned_Subtype (E))); | |
2286 | Set_Alignment (E, Alignment (Cloned_Subtype (E))); | |
2287 | ||
2288 | -- Another special case, class-wide types. The RM says that the size | |
2289 | -- of such types is implementation defined (RM 13.3(48)). What we do | |
2290 | -- here is to leave the fields set as unknown values, and the backend | |
2291 | -- determines the actual behavior. | |
2292 | ||
2293 | elsif Ekind (E) = E_Class_Wide_Type then | |
2294 | null; | |
2295 | ||
2296 | -- All other cases | |
2297 | ||
2298 | else | |
5e640318 | 2299 | -- Initialize alignment conservatively to 1. This value will be |
2300 | -- increased as necessary during processing of the record. | |
83cce46b | 2301 | |
2302 | if Unknown_Alignment (E) then | |
2303 | Set_Alignment (E, Uint_1); | |
2304 | end if; | |
2305 | ||
5e640318 | 2306 | -- Initialize previous component. This is Empty unless there are |
2307 | -- components which have already been laid out by component clauses. | |
2308 | -- If there are such components, we start our lay out of the | |
2309 | -- remaining components following the last such component. | |
83cce46b | 2310 | |
2311 | Prev_Comp := Empty; | |
2312 | ||
db00d7ec | 2313 | Comp := First_Component_Or_Discriminant (E); |
83cce46b | 2314 | while Present (Comp) loop |
db00d7ec | 2315 | if Present (Component_Clause (Comp)) then |
83cce46b | 2316 | if No (Prev_Comp) |
2317 | or else | |
2318 | Component_Bit_Offset (Comp) > | |
2319 | Component_Bit_Offset (Prev_Comp) | |
2320 | then | |
2321 | Prev_Comp := Comp; | |
2322 | end if; | |
2323 | end if; | |
2324 | ||
db00d7ec | 2325 | Next_Component_Or_Discriminant (Comp); |
83cce46b | 2326 | end loop; |
2327 | ||
2328 | -- We have two separate circuits, one for non-variant records and | |
2329 | -- one for variant records. For non-variant records, we simply go | |
2330 | -- through the list of components. This handles all the non-variant | |
2331 | -- cases including those cases of subtypes where there is no full | |
2332 | -- type declaration, so the tree cannot be used to drive the layout. | |
2333 | -- For variant records, we have to drive the layout from the tree | |
2334 | -- since we need to understand the variant structure in this case. | |
2335 | ||
2336 | if Present (Full_View (E)) then | |
2337 | Decl := Declaration_Node (Full_View (E)); | |
2338 | else | |
2339 | Decl := Declaration_Node (E); | |
2340 | end if; | |
2341 | ||
2342 | -- Scan all the components | |
2343 | ||
2344 | if Nkind (Decl) = N_Full_Type_Declaration | |
2345 | and then Has_Discriminants (E) | |
2346 | and then Nkind (Type_Definition (Decl)) = N_Record_Definition | |
9dfe12ae | 2347 | and then Present (Component_List (Type_Definition (Decl))) |
83cce46b | 2348 | and then |
2349 | Present (Variant_Part (Component_List (Type_Definition (Decl)))) | |
2350 | then | |
2351 | Layout_Variant_Record; | |
2352 | else | |
2353 | Layout_Non_Variant_Record; | |
2354 | end if; | |
2355 | end if; | |
2356 | end Layout_Record_Type; | |
2357 | ||
2358 | ----------------- | |
2359 | -- Layout_Type -- | |
2360 | ----------------- | |
2361 | ||
2362 | procedure Layout_Type (E : Entity_Id) is | |
a172e4ef | 2363 | Desig_Type : Entity_Id; |
2364 | ||
83cce46b | 2365 | begin |
5e640318 | 2366 | -- For string literal types, for now, kill the size always, this is |
2367 | -- because gigi does not like or need the size to be set ??? | |
83cce46b | 2368 | |
2369 | if Ekind (E) = E_String_Literal_Subtype then | |
2370 | Set_Esize (E, Uint_0); | |
2371 | Set_RM_Size (E, Uint_0); | |
2372 | return; | |
2373 | end if; | |
2374 | ||
5e640318 | 2375 | -- For access types, set size/alignment. This is system address size, |
2376 | -- except for fat pointers (unconstrained array access types), where the | |
2377 | -- size is two times the address size, to accommodate the two pointers | |
2378 | -- that are required for a fat pointer (data and template). Note that | |
2379 | -- E_Access_Protected_Subprogram_Type is not an access type for this | |
2380 | -- purpose since it is not a pointer but is equivalent to a record. For | |
2381 | -- access subtypes, copy the size from the base type since Gigi | |
2382 | -- represents them the same way. | |
83cce46b | 2383 | |
2384 | if Is_Access_Type (E) then | |
2385 | ||
a172e4ef | 2386 | Desig_Type := Underlying_Type (Designated_Type (E)); |
2387 | ||
2388 | -- If we only have a limited view of the type, see whether the | |
2389 | -- non-limited view is available. | |
2390 | ||
2391 | if From_With_Type (Designated_Type (E)) | |
2392 | and then Ekind (Designated_Type (E)) = E_Incomplete_Type | |
2393 | and then Present (Non_Limited_View (Designated_Type (E))) | |
2394 | then | |
2395 | Desig_Type := Non_Limited_View (Designated_Type (E)); | |
2396 | end if; | |
2397 | ||
5e640318 | 2398 | -- If Esize already set (e.g. by a size clause), then nothing further |
2399 | -- to be done here. | |
83cce46b | 2400 | |
2401 | if Known_Esize (E) then | |
2402 | null; | |
2403 | ||
5e640318 | 2404 | -- Access to subprogram is a strange beast, and we let the backend |
2405 | -- figure out what is needed (it may be some kind of fat pointer, | |
2406 | -- including the static link for example. | |
83cce46b | 2407 | |
db00d7ec | 2408 | elsif Is_Access_Protected_Subprogram_Type (E) then |
83cce46b | 2409 | null; |
2410 | ||
2411 | -- For access subtypes, copy the size information from base type | |
2412 | ||
2413 | elsif Ekind (E) = E_Access_Subtype then | |
2414 | Set_Size_Info (E, Base_Type (E)); | |
2415 | Set_RM_Size (E, RM_Size (Base_Type (E))); | |
2416 | ||
5e640318 | 2417 | -- For other access types, we use either address size, or, if a fat |
2418 | -- pointer is used (pointer-to-unconstrained array case), twice the | |
2419 | -- address size to accommodate a fat pointer. | |
83cce46b | 2420 | |
a172e4ef | 2421 | elsif Present (Desig_Type) |
2422 | and then Is_Array_Type (Desig_Type) | |
2423 | and then not Is_Constrained (Desig_Type) | |
2424 | and then not Has_Completion_In_Body (Desig_Type) | |
c410bb47 | 2425 | and then not Debug_Flag_6 |
2426 | then | |
2427 | Init_Size (E, 2 * System_Address_Size); | |
83cce46b | 2428 | |
c410bb47 | 2429 | -- Check for bad convention set |
83cce46b | 2430 | |
c410bb47 | 2431 | if Warn_On_Export_Import |
2432 | and then | |
2433 | (Convention (E) = Convention_C | |
2434 | or else | |
2435 | Convention (E) = Convention_CPP) | |
2436 | then | |
2437 | Error_Msg_N | |
cb97ae5c | 2438 | ("?x?this access type does not correspond to C pointer", E); |
c410bb47 | 2439 | end if; |
83cce46b | 2440 | |
5e640318 | 2441 | -- If the designated type is a limited view it is unanalyzed. We can |
2442 | -- examine the declaration itself to determine whether it will need a | |
2443 | -- fat pointer. | |
a172e4ef | 2444 | |
2445 | elsif Present (Desig_Type) | |
2446 | and then Present (Parent (Desig_Type)) | |
2447 | and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration | |
2448 | and then | |
2449 | Nkind (Type_Definition (Parent (Desig_Type))) | |
2450 | = N_Unconstrained_Array_Definition | |
3cce7f32 | 2451 | and then not Debug_Flag_6 |
a172e4ef | 2452 | then |
2453 | Init_Size (E, 2 * System_Address_Size); | |
2454 | ||
c410bb47 | 2455 | -- When the target is AAMP, access-to-subprogram types are fat |
2ff0322d | 2456 | -- pointers consisting of the subprogram address and a static link, |
2457 | -- with the exception of library-level access types (including | |
2458 | -- library-level anonymous access types, such as for components), | |
2459 | -- where a simple subprogram address is used. | |
545c2c19 | 2460 | |
c410bb47 | 2461 | elsif AAMP_On_Target |
2462 | and then | |
2ff0322d | 2463 | ((Ekind (E) = E_Access_Subprogram_Type |
c7dbb79e | 2464 | and then Present (Enclosing_Subprogram (E))) |
2465 | or else | |
2466 | (Ekind (E) = E_Anonymous_Access_Subprogram_Type | |
2467 | and then | |
2468 | (not Is_Local_Anonymous_Access (E) | |
2469 | or else Present (Enclosing_Subprogram (E))))) | |
c410bb47 | 2470 | then |
2471 | Init_Size (E, 2 * System_Address_Size); | |
c410bb47 | 2472 | else |
2473 | Init_Size (E, System_Address_Size); | |
83cce46b | 2474 | end if; |
2475 | ||
d1cf00c6 | 2476 | -- On VMS, reset size to 32 for convention C access type if no |
2477 | -- explicit size clause is given and the default size is 64. Really | |
2478 | -- we do not know the size, since depending on options for the VMS | |
5e640318 | 2479 | -- compiler, the size of a pointer type can be 32 or 64, but choosing |
2480 | -- 32 as the default improves compatibility with legacy VMS code. | |
d1cf00c6 | 2481 | |
2482 | -- Note: we do not use Has_Size_Clause in the test below, because we | |
5e640318 | 2483 | -- want to catch the case of a derived type inheriting a size clause. |
2484 | -- We want to consider this to be an explicit size clause for this | |
2485 | -- purpose, since it would be weird not to inherit the size in this | |
2486 | -- case. | |
d1cf00c6 | 2487 | |
a172e4ef | 2488 | -- We do NOT do this if we are in -gnatdm mode on a non-VMS target |
2489 | -- since in that case we want the normal pointer representation. | |
2490 | ||
2491 | if Opt.True_VMS_Target | |
d1cf00c6 | 2492 | and then (Convention (E) = Convention_C |
2493 | or else | |
2494 | Convention (E) = Convention_CPP) | |
2495 | and then No (Get_Attribute_Definition_Clause (E, Attribute_Size)) | |
2496 | and then Esize (E) = 64 | |
2497 | then | |
2498 | Init_Size (E, 32); | |
2499 | end if; | |
2500 | ||
5c99c290 | 2501 | Set_Elem_Alignment (E); |
83cce46b | 2502 | |
2503 | -- Scalar types: set size and alignment | |
2504 | ||
2505 | elsif Is_Scalar_Type (E) then | |
2506 | ||
5e640318 | 2507 | -- For discrete types, the RM_Size and Esize must be set already, |
2508 | -- since this is part of the earlier processing and the front end is | |
2509 | -- always required to lay out the sizes of such types (since they are | |
2510 | -- available as static attributes). All we do is to check that this | |
2511 | -- rule is indeed obeyed! | |
83cce46b | 2512 | |
2513 | if Is_Discrete_Type (E) then | |
2514 | ||
3817baeb | 2515 | -- If the RM_Size is not set, then here is where we set it |
83cce46b | 2516 | |
2517 | -- Note: an RM_Size of zero looks like not set here, but this | |
2518 | -- is a rare case, and we can simply reset it without any harm. | |
2519 | ||
2520 | if not Known_RM_Size (E) then | |
2521 | Set_Discrete_RM_Size (E); | |
2522 | end if; | |
2523 | ||
2524 | -- If Esize for a discrete type is not set then set it | |
2525 | ||
2526 | if not Known_Esize (E) then | |
2527 | declare | |
2528 | S : Int := 8; | |
2529 | ||
2530 | begin | |
2531 | loop | |
2532 | -- If size is big enough, set it and exit | |
2533 | ||
2534 | if S >= RM_Size (E) then | |
2535 | Init_Esize (E, S); | |
2536 | exit; | |
2537 | ||
5e640318 | 2538 | -- If the RM_Size is greater than 64 (happens only when |
2539 | -- strange values are specified by the user, then Esize | |
2540 | -- is simply a copy of RM_Size, it will be further | |
2541 | -- refined later on) | |
83cce46b | 2542 | |
2543 | elsif S = 64 then | |
2544 | Set_Esize (E, RM_Size (E)); | |
2545 | exit; | |
2546 | ||
2547 | -- Otherwise double possible size and keep trying | |
2548 | ||
2549 | else | |
2550 | S := S * 2; | |
2551 | end if; | |
2552 | end loop; | |
2553 | end; | |
2554 | end if; | |
2555 | ||
5e640318 | 2556 | -- For non-discrete scalar types, if the RM_Size is not set, then set |
2557 | -- it now to a copy of the Esize if the Esize is set. | |
83cce46b | 2558 | |
2559 | else | |
2560 | if Known_Esize (E) and then Unknown_RM_Size (E) then | |
2561 | Set_RM_Size (E, Esize (E)); | |
2562 | end if; | |
2563 | end if; | |
2564 | ||
5c99c290 | 2565 | Set_Elem_Alignment (E); |
83cce46b | 2566 | |
5c99c290 | 2567 | -- Non-elementary (composite) types |
83cce46b | 2568 | |
2569 | else | |
448545d4 | 2570 | -- For packed arrays, take size and alignment values from the packed |
2571 | -- array type if a packed array type has been created and the fields | |
2572 | -- are not currently set. | |
2573 | ||
2574 | if Is_Array_Type (E) and then Present (Packed_Array_Type (E)) then | |
2575 | declare | |
2576 | PAT : constant Entity_Id := Packed_Array_Type (E); | |
2577 | ||
2578 | begin | |
2579 | if Unknown_Esize (E) then | |
2580 | Set_Esize (E, Esize (PAT)); | |
2581 | end if; | |
2582 | ||
2583 | if Unknown_RM_Size (E) then | |
2584 | Set_RM_Size (E, RM_Size (PAT)); | |
2585 | end if; | |
2586 | ||
2587 | if Unknown_Alignment (E) then | |
2588 | Set_Alignment (E, Alignment (PAT)); | |
2589 | end if; | |
2590 | end; | |
2591 | end if; | |
2592 | ||
5e640318 | 2593 | -- If Esize is set, and RM_Size is not, RM_Size is copied from Esize. |
2594 | -- At least for now this seems reasonable, and is in any case needed | |
2595 | -- for compatibility with old versions of gigi. | |
83cce46b | 2596 | |
ada34def | 2597 | if Known_Esize (E) and then Unknown_RM_Size (E) then |
83cce46b | 2598 | Set_RM_Size (E, Esize (E)); |
2599 | end if; | |
2600 | ||
5e640318 | 2601 | -- For array base types, set component size if object size of the |
2602 | -- component type is known and is a small power of 2 (8, 16, 32, 64), | |
2603 | -- since this is what will always be used. | |
83cce46b | 2604 | |
2605 | if Ekind (E) = E_Array_Type | |
2606 | and then Unknown_Component_Size (E) | |
2607 | then | |
2608 | declare | |
2609 | CT : constant Entity_Id := Component_Type (E); | |
2610 | ||
2611 | begin | |
5e640318 | 2612 | -- For some reasons, access types can cause trouble, So let's |
8da866b7 | 2613 | -- just do this for scalar types ??? |
83cce46b | 2614 | |
2615 | if Present (CT) | |
8da866b7 | 2616 | and then Is_Scalar_Type (CT) |
83cce46b | 2617 | and then Known_Static_Esize (CT) |
2618 | then | |
2619 | declare | |
2620 | S : constant Uint := Esize (CT); | |
83cce46b | 2621 | begin |
f3e4db96 | 2622 | if Addressable (S) then |
2623 | Set_Component_Size (E, S); | |
83cce46b | 2624 | end if; |
2625 | end; | |
2626 | end if; | |
2627 | end; | |
2628 | end if; | |
2629 | end if; | |
2630 | ||
9dfe12ae | 2631 | -- Lay out array and record types if front end layout set |
83cce46b | 2632 | |
2633 | if Frontend_Layout_On_Target then | |
2634 | if Is_Array_Type (E) and then not Is_Bit_Packed_Array (E) then | |
2635 | Layout_Array_Type (E); | |
2636 | elsif Is_Record_Type (E) then | |
2637 | Layout_Record_Type (E); | |
2638 | end if; | |
f15731c4 | 2639 | |
9dfe12ae | 2640 | -- Case of backend layout, we still do a little in the front end |
f15731c4 | 2641 | |
9dfe12ae | 2642 | else |
2643 | -- Processing for record types | |
f15731c4 | 2644 | |
9dfe12ae | 2645 | if Is_Record_Type (E) then |
f15731c4 | 2646 | |
9dfe12ae | 2647 | -- Special remaining processing for record types with a known |
2648 | -- size of 16, 32, or 64 bits whose alignment is not yet set. | |
2649 | -- For these types, we set a corresponding alignment matching | |
2650 | -- the size if possible, or as large as possible if not. | |
2651 | ||
2652 | if Convention (E) = Convention_Ada | |
2653 | and then not Debug_Flag_Q | |
2654 | then | |
2655 | Set_Composite_Alignment (E); | |
2656 | end if; | |
2657 | ||
27f48659 | 2658 | -- Processing for array types |
9dfe12ae | 2659 | |
2660 | elsif Is_Array_Type (E) then | |
2661 | ||
2662 | -- For arrays that are required to be atomic, we do the same | |
2663 | -- processing as described above for short records, since we | |
2664 | -- really need to have the alignment set for the whole array. | |
2665 | ||
2666 | if Is_Atomic (E) and then not Debug_Flag_Q then | |
2667 | Set_Composite_Alignment (E); | |
2668 | end if; | |
2669 | ||
2670 | -- For unpacked array types, set an alignment of 1 if we know | |
2671 | -- that the component alignment is not greater than 1. The reason | |
2672 | -- we do this is to avoid unnecessary copying of slices of such | |
2673 | -- arrays when passed to subprogram parameters (see special test | |
2674 | -- in Exp_Ch6.Expand_Actuals). | |
2675 | ||
2676 | if not Is_Packed (E) | |
2677 | and then Unknown_Alignment (E) | |
2678 | then | |
2679 | if Known_Static_Component_Size (E) | |
2680 | and then Component_Size (E) = 1 | |
2681 | then | |
2682 | Set_Alignment (E, Uint_1); | |
2683 | end if; | |
2684 | end if; | |
4524d1ce | 2685 | |
2686 | -- We need to know whether the size depends on the value of one | |
2687 | -- or more discriminants to select the return mechanism. Skip if | |
2688 | -- errors are present, to prevent cascaded messages. | |
2689 | ||
2690 | if Serious_Errors_Detected = 0 then | |
2691 | Compute_Size_Depends_On_Discriminant (E); | |
2692 | end if; | |
2693 | ||
9dfe12ae | 2694 | end if; |
2695 | end if; | |
2696 | ||
2697 | -- Final step is to check that Esize and RM_Size are compatible | |
2698 | ||
2699 | if Known_Static_Esize (E) and then Known_Static_RM_Size (E) then | |
2700 | if Esize (E) < RM_Size (E) then | |
2701 | ||
2702 | -- Esize is less than RM_Size. That's not good. First we test | |
2703 | -- whether this was set deliberately with an Object_Size clause | |
2704 | -- and if so, object to the clause. | |
2705 | ||
2706 | if Has_Object_Size_Clause (E) then | |
2707 | Error_Msg_Uint_1 := RM_Size (E); | |
2708 | Error_Msg_F | |
cd6ff0dc | 2709 | ("object size is too small, minimum allowed is ^", |
9dfe12ae | 2710 | Expression (Get_Attribute_Definition_Clause |
2711 | (E, Attribute_Object_Size))); | |
2712 | end if; | |
2713 | ||
2714 | -- Adjust Esize up to RM_Size value | |
2715 | ||
2716 | declare | |
2717 | Size : constant Uint := RM_Size (E); | |
2718 | ||
2719 | begin | |
2720 | Set_Esize (E, RM_Size (E)); | |
2721 | ||
5e640318 | 2722 | -- For scalar types, increase Object_Size to power of 2, but |
2723 | -- not less than a storage unit in any case (i.e., normally | |
2724 | -- this means it will be storage-unit addressable). | |
9dfe12ae | 2725 | |
2726 | if Is_Scalar_Type (E) then | |
2727 | if Size <= System_Storage_Unit then | |
2728 | Init_Esize (E, System_Storage_Unit); | |
2729 | elsif Size <= 16 then | |
2730 | Init_Esize (E, 16); | |
2731 | elsif Size <= 32 then | |
2732 | Init_Esize (E, 32); | |
2733 | else | |
2734 | Set_Esize (E, (Size + 63) / 64 * 64); | |
2735 | end if; | |
2736 | ||
2737 | -- Finally, make sure that alignment is consistent with | |
2738 | -- the newly assigned size. | |
2739 | ||
2740 | while Alignment (E) * System_Storage_Unit < Esize (E) | |
2741 | and then Alignment (E) < Maximum_Alignment | |
2742 | loop | |
2743 | Set_Alignment (E, 2 * Alignment (E)); | |
2744 | end loop; | |
2745 | end if; | |
2746 | end; | |
2747 | end if; | |
83cce46b | 2748 | end if; |
2749 | end Layout_Type; | |
2750 | ||
2751 | --------------------- | |
2752 | -- Rewrite_Integer -- | |
2753 | --------------------- | |
2754 | ||
2755 | procedure Rewrite_Integer (N : Node_Id; V : Uint) is | |
2756 | Loc : constant Source_Ptr := Sloc (N); | |
2757 | Typ : constant Entity_Id := Etype (N); | |
83cce46b | 2758 | begin |
2759 | Rewrite (N, Make_Integer_Literal (Loc, Intval => V)); | |
2760 | Set_Etype (N, Typ); | |
2761 | end Rewrite_Integer; | |
2762 | ||
2763 | ------------------------------- | |
2764 | -- Set_And_Check_Static_Size -- | |
2765 | ------------------------------- | |
2766 | ||
2767 | procedure Set_And_Check_Static_Size | |
2768 | (E : Entity_Id; | |
2769 | Esiz : SO_Ref; | |
2770 | RM_Siz : SO_Ref) | |
2771 | is | |
2772 | SC : Node_Id; | |
2773 | ||
2774 | procedure Check_Size_Too_Small (Spec : Uint; Min : Uint); | |
5e640318 | 2775 | -- Spec is the number of bit specified in the size clause, and Min is |
2776 | -- the minimum computed size. An error is given that the specified size | |
2777 | -- is too small if Spec < Min, and in this case both Esize and RM_Size | |
2778 | -- are set to unknown in E. The error message is posted on node SC. | |
83cce46b | 2779 | |
2780 | procedure Check_Unused_Bits (Spec : Uint; Max : Uint); | |
5e640318 | 2781 | -- Spec is the number of bits specified in the size clause, and Max is |
2782 | -- the maximum computed size. A warning is given about unused bits if | |
2783 | -- Spec > Max. This warning is posted on node SC. | |
83cce46b | 2784 | |
2785 | -------------------------- | |
2786 | -- Check_Size_Too_Small -- | |
2787 | -------------------------- | |
2788 | ||
2789 | procedure Check_Size_Too_Small (Spec : Uint; Min : Uint) is | |
2790 | begin | |
2791 | if Spec < Min then | |
2792 | Error_Msg_Uint_1 := Min; | |
503f7fd3 | 2793 | Error_Msg_NE ("size for & too small, minimum allowed is ^", SC, E); |
83cce46b | 2794 | Init_Esize (E); |
2795 | Init_RM_Size (E); | |
2796 | end if; | |
2797 | end Check_Size_Too_Small; | |
2798 | ||
2799 | ----------------------- | |
2800 | -- Check_Unused_Bits -- | |
2801 | ----------------------- | |
2802 | ||
2803 | procedure Check_Unused_Bits (Spec : Uint; Max : Uint) is | |
2804 | begin | |
2805 | if Spec > Max then | |
2806 | Error_Msg_Uint_1 := Spec - Max; | |
cb97ae5c | 2807 | Error_Msg_NE ("??^ bits of & unused", SC, E); |
83cce46b | 2808 | end if; |
2809 | end Check_Unused_Bits; | |
2810 | ||
2811 | -- Start of processing for Set_And_Check_Static_Size | |
2812 | ||
2813 | begin | |
2814 | -- Case where Object_Size (Esize) is already set by a size clause | |
2815 | ||
2816 | if Known_Static_Esize (E) then | |
2817 | SC := Size_Clause (E); | |
2818 | ||
2819 | if No (SC) then | |
2820 | SC := Get_Attribute_Definition_Clause (E, Attribute_Object_Size); | |
2821 | end if; | |
2822 | ||
2823 | -- Perform checks on specified size against computed sizes | |
2824 | ||
2825 | if Present (SC) then | |
2826 | Check_Unused_Bits (Esize (E), Esiz); | |
2827 | Check_Size_Too_Small (Esize (E), RM_Siz); | |
2828 | end if; | |
2829 | end if; | |
2830 | ||
5e640318 | 2831 | -- Case where Value_Size (RM_Size) is set by specific Value_Size clause |
2832 | -- (we do not need to worry about Value_Size being set by a Size clause, | |
2833 | -- since that will have set Esize as well, and we already took care of | |
2834 | -- that case). | |
83cce46b | 2835 | |
2836 | if Known_Static_RM_Size (E) then | |
2837 | SC := Get_Attribute_Definition_Clause (E, Attribute_Value_Size); | |
2838 | ||
2839 | -- Perform checks on specified size against computed sizes | |
2840 | ||
2841 | if Present (SC) then | |
2842 | Check_Unused_Bits (RM_Size (E), Esiz); | |
2843 | Check_Size_Too_Small (RM_Size (E), RM_Siz); | |
2844 | end if; | |
2845 | end if; | |
2846 | ||
2847 | -- Set sizes if unknown | |
2848 | ||
2849 | if Unknown_Esize (E) then | |
2850 | Set_Esize (E, Esiz); | |
2851 | end if; | |
2852 | ||
2853 | if Unknown_RM_Size (E) then | |
2854 | Set_RM_Size (E, RM_Siz); | |
2855 | end if; | |
2856 | end Set_And_Check_Static_Size; | |
2857 | ||
f15731c4 | 2858 | ----------------------------- |
2859 | -- Set_Composite_Alignment -- | |
2860 | ----------------------------- | |
2861 | ||
2862 | procedure Set_Composite_Alignment (E : Entity_Id) is | |
2863 | Siz : Uint; | |
2864 | Align : Nat; | |
2865 | ||
2866 | begin | |
2253aba6 | 2867 | -- If alignment is already set, then nothing to do |
2868 | ||
2869 | if Known_Alignment (E) then | |
2870 | return; | |
2871 | end if; | |
2872 | ||
2873 | -- Alignment is not known, see if we can set it, taking into account | |
2874 | -- the setting of the Optimize_Alignment mode. | |
2875 | ||
509f74d3 | 2876 | -- If Optimize_Alignment is set to Space, then we try to give packed |
2877 | -- records an aligmment of 1, unless there is some reason we can't. | |
2253aba6 | 2878 | |
3a2db8ab | 2879 | if Optimize_Alignment_Space (E) |
2253aba6 | 2880 | and then Is_Record_Type (E) |
2881 | and then Is_Packed (E) | |
2253aba6 | 2882 | then |
509f74d3 | 2883 | -- No effect for record with atomic components |
2884 | ||
2885 | if Is_Atomic (E) then | |
2886 | Error_Msg_N ("Optimize_Alignment has no effect for &??", E); | |
2887 | Error_Msg_N ("\pragma ignored for atomic record??", E); | |
2888 | return; | |
2889 | end if; | |
2890 | ||
2891 | -- No effect if independent components | |
2892 | ||
2893 | if Has_Independent_Components (E) then | |
2894 | Error_Msg_N ("Optimize_Alignment has no effect for &??", E); | |
2895 | Error_Msg_N | |
2896 | ("\pragma ignored for record with independent components??", E); | |
2897 | return; | |
2898 | end if; | |
2899 | ||
2900 | -- No effect if any component is atomic or is a by reference type | |
2901 | ||
2902 | declare | |
2903 | Ent : Entity_Id; | |
2904 | begin | |
2905 | Ent := First_Component_Or_Discriminant (E); | |
2906 | while Present (Ent) loop | |
2907 | if Is_By_Reference_Type (Etype (Ent)) | |
2908 | or else Is_Atomic (Etype (Ent)) | |
2909 | or else Is_Atomic (Ent) | |
2910 | then | |
2911 | Error_Msg_N ("Optimize_Alignment has no effect for &??", E); | |
2912 | Error_Msg_N | |
2913 | ("\pragma is ignored if atomic components present??", E); | |
2914 | return; | |
2915 | else | |
2916 | Next_Component_Or_Discriminant (Ent); | |
2917 | end if; | |
2918 | end loop; | |
2919 | end; | |
2920 | ||
2921 | -- Optimize_Alignment has no effect on variable length record | |
2922 | ||
fcee6529 | 2923 | if not Size_Known_At_Compile_Time (E) then |
cb97ae5c | 2924 | Error_Msg_N ("Optimize_Alignment has no effect for &??", E); |
2925 | Error_Msg_N ("\pragma is ignored for variable length record??", E); | |
509f74d3 | 2926 | return; |
fcee6529 | 2927 | end if; |
2253aba6 | 2928 | |
509f74d3 | 2929 | -- All tests passed, we can set alignment to 1 |
2930 | ||
2931 | Align := 1; | |
2932 | ||
2253aba6 | 2933 | -- Not a record, or not packed |
2934 | ||
2935 | else | |
2936 | -- The only other cases we worry about here are where the size is | |
27f48659 | 2937 | -- statically known at compile time. |
2253aba6 | 2938 | |
f15731c4 | 2939 | if Known_Static_Esize (E) then |
2940 | Siz := Esize (E); | |
2941 | ||
2942 | elsif Unknown_Esize (E) | |
2943 | and then Known_Static_RM_Size (E) | |
2944 | then | |
2945 | Siz := RM_Size (E); | |
2946 | ||
2947 | else | |
2948 | return; | |
2949 | end if; | |
2950 | ||
2951 | -- Size is known, alignment is not set | |
2952 | ||
2253aba6 | 2953 | -- Reset alignment to match size if the known size is exactly 2, 4, |
2954 | -- or 8 storage units. | |
9dfe12ae | 2955 | |
2956 | if Siz = 2 * System_Storage_Unit then | |
f15731c4 | 2957 | Align := 2; |
2958 | elsif Siz = 4 * System_Storage_Unit then | |
2959 | Align := 4; | |
2960 | elsif Siz = 8 * System_Storage_Unit then | |
2961 | Align := 8; | |
9dfe12ae | 2962 | |
2253aba6 | 2963 | -- If Optimize_Alignment is set to Space, then make sure the |
2964 | -- alignment matches the size, for example, if the size is 17 | |
2965 | -- bytes then we want an alignment of 1 for the type. | |
2966 | ||
3a2db8ab | 2967 | elsif Optimize_Alignment_Space (E) then |
2253aba6 | 2968 | if Siz mod (8 * System_Storage_Unit) = 0 then |
2969 | Align := 8; | |
2970 | elsif Siz mod (4 * System_Storage_Unit) = 0 then | |
2971 | Align := 4; | |
2972 | elsif Siz mod (2 * System_Storage_Unit) = 0 then | |
2973 | Align := 2; | |
2974 | else | |
2975 | Align := 1; | |
2976 | end if; | |
2977 | ||
2978 | -- If Optimize_Alignment is set to Time, then we reset for odd | |
2979 | -- "in between sizes", for example a 17 bit record is given an | |
2980 | -- alignment of 4. Note that this matches the old VMS behavior | |
2981 | -- in versions of GNAT prior to 6.1.1. | |
9dfe12ae | 2982 | |
3a2db8ab | 2983 | elsif Optimize_Alignment_Time (E) |
a13923ff | 2984 | and then Siz > System_Storage_Unit |
2253aba6 | 2985 | and then Siz <= 8 * System_Storage_Unit |
a13923ff | 2986 | then |
9dfe12ae | 2987 | if Siz <= 2 * System_Storage_Unit then |
2988 | Align := 2; | |
2989 | elsif Siz <= 4 * System_Storage_Unit then | |
2990 | Align := 4; | |
2253aba6 | 2991 | else -- Siz <= 8 * System_Storage_Unit then |
9dfe12ae | 2992 | Align := 8; |
9dfe12ae | 2993 | end if; |
2994 | ||
2253aba6 | 2995 | -- No special alignment fiddling needed |
9dfe12ae | 2996 | |
f15731c4 | 2997 | else |
2998 | return; | |
2999 | end if; | |
2253aba6 | 3000 | end if; |
f15731c4 | 3001 | |
2253aba6 | 3002 | -- Here we have Set Align to the proposed improved value. Make sure the |
3003 | -- value set does not exceed Maximum_Alignment for the target. | |
9dfe12ae | 3004 | |
2253aba6 | 3005 | if Align > Maximum_Alignment then |
3006 | Align := Maximum_Alignment; | |
3007 | end if; | |
f15731c4 | 3008 | |
2253aba6 | 3009 | -- Further processing for record types only to reduce the alignment |
3010 | -- set by the above processing in some specific cases. We do not | |
3011 | -- do this for atomic records, since we need max alignment there, | |
9dfe12ae | 3012 | |
2253aba6 | 3013 | if Is_Record_Type (E) and then not Is_Atomic (E) then |
9dfe12ae | 3014 | |
2253aba6 | 3015 | -- For records, there is generally no point in setting alignment |
3016 | -- higher than word size since we cannot do better than move by | |
3017 | -- words in any case. Omit this if we are optimizing for time, | |
3018 | -- since conceivably we may be able to do better. | |
9dfe12ae | 3019 | |
2253aba6 | 3020 | if Align > System_Word_Size / System_Storage_Unit |
3a2db8ab | 3021 | and then not Optimize_Alignment_Time (E) |
2253aba6 | 3022 | then |
3023 | Align := System_Word_Size / System_Storage_Unit; | |
3024 | end if; | |
9dfe12ae | 3025 | |
2253aba6 | 3026 | -- Check components. If any component requires a higher alignment, |
3027 | -- then we set that higher alignment in any case. Don't do this if | |
3028 | -- we have Optimize_Alignment set to Space. Note that that covers | |
27f48659 | 3029 | -- the case of packed records, where we already set alignment to 1. |
9dfe12ae | 3030 | |
3a2db8ab | 3031 | if not Optimize_Alignment_Space (E) then |
9dfe12ae | 3032 | declare |
3033 | Comp : Entity_Id; | |
3034 | ||
3035 | begin | |
3036 | Comp := First_Component (E); | |
3037 | while Present (Comp) loop | |
3038 | if Known_Alignment (Etype (Comp)) then | |
3039 | declare | |
3040 | Calign : constant Uint := Alignment (Etype (Comp)); | |
3041 | ||
3042 | begin | |
2253aba6 | 3043 | -- The cases to process are when the alignment of the |
3044 | -- component type is larger than the alignment we have | |
3045 | -- so far, and either there is no component clause for | |
3046 | -- the component, or the length set by the component | |
3047 | -- clause matches the length of the component type. | |
9dfe12ae | 3048 | |
3049 | if Calign > Align | |
3050 | and then | |
3051 | (Unknown_Esize (Comp) | |
2253aba6 | 3052 | or else (Known_Static_Esize (Comp) |
3053 | and then | |
3054 | Esize (Comp) = | |
3055 | Calign * System_Storage_Unit)) | |
9dfe12ae | 3056 | then |
3057 | Align := UI_To_Int (Calign); | |
3058 | end if; | |
3059 | end; | |
3060 | end if; | |
3061 | ||
3062 | Next_Component (Comp); | |
3063 | end loop; | |
3064 | end; | |
f15731c4 | 3065 | end if; |
2253aba6 | 3066 | end if; |
f15731c4 | 3067 | |
5e640318 | 3068 | -- Set chosen alignment, and increase Esize if necessary to match the |
3069 | -- chosen alignment. | |
9dfe12ae | 3070 | |
2253aba6 | 3071 | Set_Alignment (E, UI_From_Int (Align)); |
f15731c4 | 3072 | |
2253aba6 | 3073 | if Known_Static_Esize (E) |
3074 | and then Esize (E) < Align * System_Storage_Unit | |
3075 | then | |
3076 | Set_Esize (E, UI_From_Int (Align * System_Storage_Unit)); | |
f15731c4 | 3077 | end if; |
3078 | end Set_Composite_Alignment; | |
3079 | ||
83cce46b | 3080 | -------------------------- |
3081 | -- Set_Discrete_RM_Size -- | |
3082 | -------------------------- | |
3083 | ||
3084 | procedure Set_Discrete_RM_Size (Def_Id : Entity_Id) is | |
3085 | FST : constant Entity_Id := First_Subtype (Def_Id); | |
3086 | ||
3087 | begin | |
5e640318 | 3088 | -- All discrete types except for the base types in standard are |
3089 | -- constrained, so indicate this by setting Is_Constrained. | |
83cce46b | 3090 | |
3091 | Set_Is_Constrained (Def_Id); | |
3092 | ||
5e640318 | 3093 | -- Set generic types to have an unknown size, since the representation |
3094 | -- of a generic type is irrelevant, in view of the fact that they have | |
3095 | -- nothing to do with code. | |
83cce46b | 3096 | |
3097 | if Is_Generic_Type (Root_Type (FST)) then | |
3098 | Set_RM_Size (Def_Id, Uint_0); | |
3099 | ||
5e640318 | 3100 | -- If the subtype statically matches the first subtype, then it is |
3101 | -- required to have exactly the same layout. This is required by | |
3102 | -- aliasing considerations. | |
83cce46b | 3103 | |
3104 | elsif Def_Id /= FST and then | |
3105 | Subtypes_Statically_Match (Def_Id, FST) | |
3106 | then | |
3107 | Set_RM_Size (Def_Id, RM_Size (FST)); | |
3108 | Set_Size_Info (Def_Id, FST); | |
3109 | ||
5e640318 | 3110 | -- In all other cases the RM_Size is set to the minimum size. Note that |
3111 | -- this routine is never called for subtypes for which the RM_Size is | |
3112 | -- set explicitly by an attribute clause. | |
83cce46b | 3113 | |
3114 | else | |
3115 | Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id))); | |
3116 | end if; | |
3117 | end Set_Discrete_RM_Size; | |
3118 | ||
3119 | ------------------------ | |
5c99c290 | 3120 | -- Set_Elem_Alignment -- |
83cce46b | 3121 | ------------------------ |
3122 | ||
5c99c290 | 3123 | procedure Set_Elem_Alignment (E : Entity_Id) is |
83cce46b | 3124 | begin |
3125 | -- Do not set alignment for packed array types, unless we are doing | |
3126 | -- front end layout, because otherwise this is always handled in the | |
3127 | -- backend. | |
3128 | ||
3129 | if Is_Packed_Array_Type (E) and then not Frontend_Layout_On_Target then | |
3130 | return; | |
3131 | ||
3132 | -- If there is an alignment clause, then we respect it | |
3133 | ||
3134 | elsif Has_Alignment_Clause (E) then | |
3135 | return; | |
3136 | ||
3137 | -- If the size is not set, then don't attempt to set the alignment. This | |
9dfe12ae | 3138 | -- happens in the backend layout case for access-to-subprogram types. |
83cce46b | 3139 | |
3140 | elsif not Known_Static_Esize (E) then | |
3141 | return; | |
3142 | ||
3143 | -- For access types, do not set the alignment if the size is less than | |
3144 | -- the allowed minimum size. This avoids cascaded error messages. | |
3145 | ||
3146 | elsif Is_Access_Type (E) | |
3147 | and then Esize (E) < System_Address_Size | |
3148 | then | |
3149 | return; | |
3150 | end if; | |
3151 | ||
5e640318 | 3152 | -- Here we calculate the alignment as the largest power of two multiple |
6dbcfcd9 | 3153 | -- of System.Storage_Unit that does not exceed either the object size of |
5e640318 | 3154 | -- the type, or the maximum allowed alignment. |
83cce46b | 3155 | |
3156 | declare | |
b43a5770 | 3157 | S : Int; |
3158 | A : Nat; | |
a940e5c9 | 3159 | |
45cedf2e | 3160 | Max_Alignment : Nat; |
83cce46b | 3161 | |
3162 | begin | |
b43a5770 | 3163 | -- The given Esize may be larger that int'last because of a previous |
a940e5c9 | 3164 | -- error, and the call to UI_To_Int will fail, so use default. |
3165 | ||
3166 | if Esize (E) / SSU > Ttypes.Maximum_Alignment then | |
3167 | S := Ttypes.Maximum_Alignment; | |
0ade479e | 3168 | |
3169 | -- If this is an access type and the target doesn't have strict | |
3170 | -- alignment and we are not doing front end layout, then cap the | |
3171 | -- alignment to that of a regular access type. This will avoid | |
3172 | -- giving fat pointers twice the usual alignment for no practical | |
3173 | -- benefit since the misalignment doesn't really matter. | |
3174 | ||
3175 | elsif Is_Access_Type (E) | |
3176 | and then not Target_Strict_Alignment | |
3177 | and then not Frontend_Layout_On_Target | |
3178 | then | |
3179 | S := System_Address_Size / SSU; | |
3180 | ||
a940e5c9 | 3181 | else |
3182 | S := UI_To_Int (Esize (E)) / SSU; | |
3183 | end if; | |
3184 | ||
d4b7e0f5 | 3185 | -- If the default alignment of "double" floating-point types is |
3186 | -- specifically capped, enforce the cap. | |
3187 | ||
3188 | if Ttypes.Target_Double_Float_Alignment > 0 | |
3189 | and then S = 8 | |
3190 | and then Is_Floating_Point_Type (E) | |
3191 | then | |
3192 | Max_Alignment := Ttypes.Target_Double_Float_Alignment; | |
3193 | ||
3194 | -- If the default alignment of "double" or larger scalar types is | |
3195 | -- specifically capped, enforce the cap. | |
3196 | ||
3197 | elsif Ttypes.Target_Double_Scalar_Alignment > 0 | |
3198 | and then S >= 8 | |
3199 | and then Is_Scalar_Type (E) | |
3200 | then | |
3201 | Max_Alignment := Ttypes.Target_Double_Scalar_Alignment; | |
3202 | ||
3203 | -- Otherwise enforce the overall alignment cap | |
3204 | ||
3205 | else | |
3206 | Max_Alignment := Ttypes.Maximum_Alignment; | |
3207 | end if; | |
3208 | ||
83cce46b | 3209 | A := 1; |
d4b7e0f5 | 3210 | while 2 * A <= Max_Alignment and then 2 * A <= S loop |
83cce46b | 3211 | A := 2 * A; |
3212 | end loop; | |
3213 | ||
6dbcfcd9 | 3214 | -- If alignment is currently not set, then we can safetly set it to |
3215 | -- this new calculated value. | |
83cce46b | 3216 | |
6dbcfcd9 | 3217 | if Unknown_Alignment (E) then |
3218 | Init_Alignment (E, A); | |
3219 | ||
3220 | -- Cases where we have inherited an alignment | |
3221 | ||
3222 | -- For constructed types, always reset the alignment, these are | |
3223 | -- Generally invisible to the user anyway, and that way we are | |
3224 | -- sure that no constructed types have weird alignments. | |
3225 | ||
3226 | elsif not Comes_From_Source (E) then | |
3227 | Init_Alignment (E, A); | |
3228 | ||
3229 | -- If this inherited alignment is the same as the one we computed, | |
3230 | -- then obviously everything is fine, and we do not need to reset it. | |
83cce46b | 3231 | |
6dbcfcd9 | 3232 | elsif Alignment (E) = A then |
3233 | null; | |
83cce46b | 3234 | |
6dbcfcd9 | 3235 | -- Now we come to the difficult cases where we have inherited an |
3236 | -- alignment and size, but overridden the size but not the alignment. | |
3237 | ||
3238 | elsif Has_Size_Clause (E) or else Has_Object_Size_Clause (E) then | |
3239 | ||
3240 | -- This is tricky, it might be thought that we should try to | |
3241 | -- inherit the alignment, since that's what the RM implies, but | |
3242 | -- that leads to complex rules and oddities. Consider for example: | |
3243 | ||
3244 | -- type R is new Character; | |
3245 | -- for R'Size use 16; | |
3246 | ||
3247 | -- It seems quite bogus in this case to inherit an alignment of 1 | |
3248 | -- from the parent type Character. Furthermore, if that's what the | |
3249 | -- programmer really wanted for some odd reason, then they could | |
3250 | -- specify the alignment they wanted. | |
3251 | ||
3252 | -- Furthermore we really don't want to inherit the alignment in | |
3253 | -- the case of a specified Object_Size for a subtype, since then | |
3254 | -- there would be no way of overriding to give a reasonable value | |
3255 | -- (we don't have an Object_Subtype attribute). Consider: | |
3256 | ||
3257 | -- subtype R is new Character; | |
3258 | -- for R'Object_Size use 16; | |
3259 | ||
3260 | -- If we inherit the alignment of 1, then we have an odd | |
3261 | -- inefficient alignment for the subtype, which cannot be fixed. | |
3262 | ||
3263 | -- So we make the decision that if Size (or Object_Size) is given | |
3264 | -- (and, in the case of a first subtype, the alignment is not set | |
3265 | -- with a specific alignment clause). We reset the alignment to | |
3266 | -- the appropriate value for the specified size. This is a nice | |
3267 | -- simple rule to implement and document. | |
3268 | ||
3269 | -- There is one slight glitch, which is that a confirming size | |
3270 | -- clause can now change the alignment, which, if we really think | |
3271 | -- that confirming rep clauses should have no effect, is a no-no. | |
3272 | ||
3273 | -- type R is new Character; | |
3274 | -- for R'Alignment use 2; | |
3275 | -- type S is new R; | |
3276 | -- for S'Size use Character'Size; | |
3277 | ||
3278 | -- Now the alignment of S is 1 instead of 2, as a result of | |
3279 | -- applying the above rule to the confirming rep clause for S. Not | |
3280 | -- clear this is worth worrying about. If we recorded whether a | |
3281 | -- size clause was confirming we could avoid this, but right now | |
3282 | -- we have no way of doing that or easily figuring it out, so we | |
3283 | -- don't bother. | |
3284 | ||
3285 | -- Historical note. In versions of GNAT prior to Nov 6th, 2010, an | |
3286 | -- odd distinction was made between inherited alignments greater | |
3287 | -- than the computed alignment (where the larger alignment was | |
3288 | -- inherited) and inherited alignments smaller than the computed | |
3289 | -- alignment (where the smaller alignment was overridden). This | |
3290 | -- was a dubious fix to get around an ACATS problem which seems | |
3291 | -- to have disappeared anyway, and in any case, this peculiarity | |
3292 | -- was never documented. | |
83cce46b | 3293 | |
83cce46b | 3294 | Init_Alignment (E, A); |
6dbcfcd9 | 3295 | |
3296 | -- If no Size (or Object_Size) was specified, then we inherited the | |
3297 | -- object size, so we should inherit the alignment as well and not | |
3298 | -- modify it. This takes care of cases like: | |
3299 | ||
3300 | -- type R is new Integer; | |
3301 | -- for R'Alignment use 1; | |
3302 | -- subtype S is R; | |
3303 | ||
3304 | -- Here we have R has a default Object_Size of 32, and a specified | |
3305 | -- alignment of 1, and it seeems right for S to inherit both values. | |
3306 | ||
3307 | else | |
3308 | null; | |
83cce46b | 3309 | end if; |
3310 | end; | |
5c99c290 | 3311 | end Set_Elem_Alignment; |
83cce46b | 3312 | |
3313 | ---------------------- | |
3314 | -- SO_Ref_From_Expr -- | |
3315 | ---------------------- | |
3316 | ||
3317 | function SO_Ref_From_Expr | |
3318 | (Expr : Node_Id; | |
3319 | Ins_Type : Entity_Id; | |
9dfe12ae | 3320 | Vtype : Entity_Id := Empty; |
d1cf00c6 | 3321 | Make_Func : Boolean := False) return Dynamic_SO_Ref |
83cce46b | 3322 | is |
3323 | Loc : constant Source_Ptr := Sloc (Ins_Type); | |
6cd460aa | 3324 | K : constant Entity_Id := Make_Temporary (Loc, 'K'); |
83cce46b | 3325 | Decl : Node_Id; |
3326 | ||
c2258dde | 3327 | Vtype_Primary_View : Entity_Id; |
3328 | ||
83cce46b | 3329 | function Check_Node_V_Ref (N : Node_Id) return Traverse_Result; |
3330 | -- Function used to check one node for reference to V | |
3331 | ||
3332 | function Has_V_Ref is new Traverse_Func (Check_Node_V_Ref); | |
3333 | -- Function used to traverse tree to check for reference to V | |
3334 | ||
3335 | ---------------------- | |
3336 | -- Check_Node_V_Ref -- | |
3337 | ---------------------- | |
3338 | ||
3339 | function Check_Node_V_Ref (N : Node_Id) return Traverse_Result is | |
3340 | begin | |
3341 | if Nkind (N) = N_Identifier then | |
3342 | if Chars (N) = Vname then | |
3343 | return Abandon; | |
3344 | else | |
3345 | return Skip; | |
3346 | end if; | |
3347 | ||
3348 | else | |
3349 | return OK; | |
3350 | end if; | |
3351 | end Check_Node_V_Ref; | |
3352 | ||
3353 | -- Start of processing for SO_Ref_From_Expr | |
3354 | ||
3355 | begin | |
3356 | -- Case of expression is an integer literal, in this case we just | |
3357 | -- return the value (which must always be non-negative, since size | |
3358 | -- and offset values can never be negative). | |
3359 | ||
3360 | if Nkind (Expr) = N_Integer_Literal then | |
3361 | pragma Assert (Intval (Expr) >= 0); | |
3362 | return Intval (Expr); | |
3363 | end if; | |
3364 | ||
3365 | -- Case where there is a reference to V, create function | |
3366 | ||
3367 | if Has_V_Ref (Expr) = Abandon then | |
3368 | ||
3369 | pragma Assert (Present (Vtype)); | |
c2258dde | 3370 | |
3371 | -- Check whether Vtype is a view of a private type and ensure that | |
3372 | -- we use the primary view of the type (which is denoted by its | |
3373 | -- Etype, whether it's the type's partial or full view entity). | |
3374 | -- This is needed to make sure that we use the same (primary) view | |
3375 | -- of the type for all V formals, whether the current view of the | |
3376 | -- type is the partial or full view, so that types will always | |
3377 | -- match on calls from one size function to another. | |
3378 | ||
3379 | if Has_Private_Declaration (Vtype) then | |
3380 | Vtype_Primary_View := Etype (Vtype); | |
3381 | else | |
3382 | Vtype_Primary_View := Vtype; | |
3383 | end if; | |
3384 | ||
83cce46b | 3385 | Set_Is_Discrim_SO_Function (K); |
3386 | ||
3387 | Decl := | |
3388 | Make_Subprogram_Body (Loc, | |
3389 | ||
3390 | Specification => | |
3391 | Make_Function_Specification (Loc, | |
3392 | Defining_Unit_Name => K, | |
3393 | Parameter_Specifications => New_List ( | |
3394 | Make_Parameter_Specification (Loc, | |
3395 | Defining_Identifier => | |
3396 | Make_Defining_Identifier (Loc, Chars => Vname), | |
3397 | Parameter_Type => | |
c2258dde | 3398 | New_Occurrence_Of (Vtype_Primary_View, Loc))), |
a03805da | 3399 | Result_Definition => |
83cce46b | 3400 | New_Occurrence_Of (Standard_Unsigned, Loc)), |
3401 | ||
3402 | Declarations => Empty_List, | |
3403 | ||
3404 | Handled_Statement_Sequence => | |
3405 | Make_Handled_Sequence_Of_Statements (Loc, | |
3406 | Statements => New_List ( | |
545c2c19 | 3407 | Make_Simple_Return_Statement (Loc, |
83cce46b | 3408 | Expression => Expr)))); |
3409 | ||
5e640318 | 3410 | -- The caller requests that the expression be encapsulated in a |
3411 | -- parameterless function. | |
9dfe12ae | 3412 | |
3413 | elsif Make_Func then | |
3414 | Decl := | |
3415 | Make_Subprogram_Body (Loc, | |
3416 | ||
3417 | Specification => | |
3418 | Make_Function_Specification (Loc, | |
3419 | Defining_Unit_Name => K, | |
3420 | Parameter_Specifications => Empty_List, | |
a03805da | 3421 | Result_Definition => |
3422 | New_Occurrence_Of (Standard_Unsigned, Loc)), | |
9dfe12ae | 3423 | |
3424 | Declarations => Empty_List, | |
3425 | ||
3426 | Handled_Statement_Sequence => | |
3427 | Make_Handled_Sequence_Of_Statements (Loc, | |
3428 | Statements => New_List ( | |
545c2c19 | 3429 | Make_Simple_Return_Statement (Loc, Expression => Expr)))); |
9dfe12ae | 3430 | |
3431 | -- No reference to V and function not requested, so create a constant | |
83cce46b | 3432 | |
3433 | else | |
3434 | Decl := | |
3435 | Make_Object_Declaration (Loc, | |
3436 | Defining_Identifier => K, | |
3437 | Object_Definition => | |
3438 | New_Occurrence_Of (Standard_Unsigned, Loc), | |
3439 | Constant_Present => True, | |
3440 | Expression => Expr); | |
3441 | end if; | |
3442 | ||
3443 | Append_Freeze_Action (Ins_Type, Decl); | |
3444 | Analyze (Decl); | |
3445 | return Create_Dynamic_SO_Ref (K); | |
3446 | end SO_Ref_From_Expr; | |
3447 | ||
3448 | end Layout; |