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