1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Atree
; use Atree
;
29 with Checks
; use Checks
;
30 with Debug
; use Debug
;
31 with Einfo
; use Einfo
;
32 with Errout
; use Errout
;
33 with Exp_Ch3
; use Exp_Ch3
;
34 with Exp_Util
; use Exp_Util
;
35 with Nlists
; use Nlists
;
36 with Nmake
; use Nmake
;
37 with Repinfo
; use Repinfo
;
39 with Sem_Ch13
; use Sem_Ch13
;
40 with Sem_Eval
; use Sem_Eval
;
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
;
50 package body Layout
is
52 ------------------------
53 -- Local Declarations --
54 ------------------------
56 SSU
: constant Int
:= Ttypes
.System_Storage_Unit
;
57 -- Short hand for System_Storage_Unit
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
64 -- function xxx (V : vtyp) return Unsigned is
66 -- return ... expression involving V.discrim
69 -----------------------
70 -- Local Subprograms --
71 -----------------------
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.
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.
87 function Assoc_Multiply
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
96 function Assoc_Subtract
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
105 function Compute_Length
(Lo
: Node_Id
; Hi
: Node_Id
) return Node_Id
;
106 -- Given expressions for the low bound (Lo) and the high bound (Hi),
107 -- Build an expression for the value hi-lo+1, converted to type
108 -- Standard.Unsigned. Takes care of the case where the operands
109 -- are of an enumeration type (so that the subtraction cannot be
110 -- done directly) by applying the Pos operator to Hi/Lo first.
112 function Expr_From_SO_Ref
116 -- Given a value D from a size or offset field, return an expression
117 -- representing the value stored. If the value is known at compile time,
118 -- then an N_Integer_Literal is returned with the appropriate value. If
119 -- the value references a constant entity, then an N_Identifier node
120 -- referencing this entity is returned. The Loc value is used for the
121 -- Sloc value of constructed notes.
123 function SO_Ref_From_Expr
125 Ins_Type
: Entity_Id
;
126 Vtype
: Entity_Id
:= Empty
)
127 return Dynamic_SO_Ref
;
128 -- This routine is used in the case where a size/offset value is dynamic
129 -- and is represented by the expression Expr. SO_Ref_From_Expr checks if
130 -- the Expr contains a reference to the identifier V, and if so builds
131 -- a function depending on discriminants of the formal parameter V which
132 -- is of type Vtype. If not, then a constant entity with the value Expr
133 -- is built. The result is a Dynamic_SO_Ref to the created entity. Note
134 -- that Vtype can be omitted if Expr does not contain any reference to V.
135 -- the created entity. The declaration created is inserted in the freeze
136 -- actions of Ins_Type, which also supplies the Sloc for created nodes.
137 -- This function also takes care of making sure that the expression is
138 -- properly analyzed and resolved (which may not be the case yet if we
139 -- build the expression in this unit).
141 function Get_Max_Size
(E
: Entity_Id
) return Node_Id
;
142 -- E is an array type or subtype that has at least one index bound that
143 -- is the value of a record discriminant. For such an array, the function
144 -- computes an expression that yields the maximum possible size of the
145 -- array in storage units. The result is not defined for any other type,
146 -- or for arrays that do not depend on discriminants, and it is a fatal
147 -- error to call this unless Size_Depends_On_Discrminant (E) is True.
149 procedure Layout_Array_Type
(E
: Entity_Id
);
150 -- Front end layout of non-bit-packed array type or subtype
152 procedure Layout_Record_Type
(E
: Entity_Id
);
153 -- Front end layout of record type
154 -- Variant records not handled yet ???
156 procedure Rewrite_Integer
(N
: Node_Id
; V
: Uint
);
157 -- Rewrite node N with an integer literal whose value is V. The Sloc
158 -- for the new node is taken from N, and the type of the literal is
159 -- set to a copy of the type of N on entry.
161 procedure Set_And_Check_Static_Size
165 -- This procedure is called to check explicit given sizes (possibly
166 -- stored in the Esize and RM_Size fields of E) against computed
167 -- Object_Size (Esiz) and Value_Size (RM_Siz) values. Appropriate
168 -- errors and warnings are posted if specified sizes are inconsistent
169 -- with specified sizes. On return, the Esize and RM_Size fields of
170 -- E are set (either from previously given values, or from the newly
171 -- computed values, as appropriate).
173 procedure Set_Composite_Alignment
(E
: Entity_Id
);
174 -- This procedure is called for record types and subtypes, and also for
175 -- atomic array types and subtypes. If no alignment is set, and the size
176 -- is 2 or 4 (or 8 if the word size is 8), then the alignment is set to
179 ----------------------------
180 -- Adjust_Esize_Alignment --
181 ----------------------------
183 procedure Adjust_Esize_Alignment
(E
: Entity_Id
) is
188 -- Nothing to do if size unknown
190 if Unknown_Esize
(E
) then
194 -- Determine if size is constrained by an attribute definition clause
195 -- which must be obeyed. If so, we cannot increase the size in this
198 -- For a type, the issue is whether an object size clause has been
199 -- set. A normal size clause constrains only the value size (RM_Size)
202 Esize_Set
:= Has_Object_Size_Clause
(E
);
204 -- For an object, the issue is whether a size clause is present
207 Esize_Set
:= Has_Size_Clause
(E
);
210 -- If size is known it must be a multiple of the byte size
212 if Esize
(E
) mod SSU
/= 0 then
214 -- If not, and size specified, then give error
218 ("size for& not a multiple of byte size", Size_Clause
(E
), E
);
221 -- Otherwise bump up size to a byte boundary
224 Set_Esize
(E
, (Esize
(E
) + SSU
- 1) / SSU
* SSU
);
228 -- Now we have the size set, it must be a multiple of the alignment
229 -- nothing more we can do here if the alignment is unknown here.
231 if Unknown_Alignment
(E
) then
235 -- At this point both the Esize and Alignment are known, so we need
236 -- to make sure they are consistent.
238 Abits
:= UI_To_Int
(Alignment
(E
)) * SSU
;
240 if Esize
(E
) mod Abits
= 0 then
244 -- Here we have a situation where the Esize is not a multiple of
245 -- the alignment. We must either increase Esize or reduce the
246 -- alignment to correct this situation.
248 -- The case in which we can decrease the alignment is where the
249 -- alignment was not set by an alignment clause, and the type in
250 -- question is a discrete type, where it is definitely safe to
251 -- reduce the alignment. For example:
253 -- t : integer range 1 .. 2;
256 -- In this situation, the initial alignment of t is 4, copied from
257 -- the Integer base type, but it is safe to reduce it to 1 at this
258 -- stage, since we will only be loading a single byte.
260 if Is_Discrete_Type
(Etype
(E
))
261 and then not Has_Alignment_Clause
(E
)
265 exit when Esize
(E
) mod Abits
= 0;
268 Init_Alignment
(E
, Abits
/ SSU
);
272 -- Now the only possible approach left is to increase the Esize
273 -- but we can't do that if the size was set by a specific clause.
277 ("size for& is not a multiple of alignment",
280 -- Otherwise we can indeed increase the size to a multiple of alignment
283 Set_Esize
(E
, ((Esize
(E
) + (Abits
- 1)) / Abits
) * Abits
);
285 end Adjust_Esize_Alignment
;
294 Right_Opnd
: Node_Id
)
301 -- Case of right operand is a constant
303 if Compile_Time_Known_Value
(Right_Opnd
) then
305 R
:= Expr_Value
(Right_Opnd
);
307 -- Case of left operand is a constant
309 elsif Compile_Time_Known_Value
(Left_Opnd
) then
311 R
:= Expr_Value
(Left_Opnd
);
313 -- Neither operand is a constant, do the addition with no optimization
316 return Make_Op_Add
(Loc
, Left_Opnd
, Right_Opnd
);
319 -- Case of left operand is an addition
321 if Nkind
(L
) = N_Op_Add
then
323 -- (C1 + E) + C2 = (C1 + C2) + E
325 if Compile_Time_Known_Value
(Sinfo
.Left_Opnd
(L
)) then
327 (Sinfo
.Left_Opnd
(L
),
328 Expr_Value
(Sinfo
.Left_Opnd
(L
)) + R
);
331 -- (E + C1) + C2 = E + (C1 + C2)
333 elsif Compile_Time_Known_Value
(Sinfo
.Right_Opnd
(L
)) then
335 (Sinfo
.Right_Opnd
(L
),
336 Expr_Value
(Sinfo
.Right_Opnd
(L
)) + R
);
340 -- Case of left operand is a subtraction
342 elsif Nkind
(L
) = N_Op_Subtract
then
344 -- (C1 - E) + C2 = (C1 + C2) + E
346 if Compile_Time_Known_Value
(Sinfo
.Left_Opnd
(L
)) then
348 (Sinfo
.Left_Opnd
(L
),
349 Expr_Value
(Sinfo
.Left_Opnd
(L
)) + R
);
352 -- (E - C1) + C2 = E - (C1 - C2)
354 elsif Compile_Time_Known_Value
(Sinfo
.Right_Opnd
(L
)) then
356 (Sinfo
.Right_Opnd
(L
),
357 Expr_Value
(Sinfo
.Right_Opnd
(L
)) - R
);
362 -- Not optimizable, do the addition
364 return Make_Op_Add
(Loc
, Left_Opnd
, Right_Opnd
);
371 function Assoc_Multiply
374 Right_Opnd
: Node_Id
)
381 -- Case of right operand is a constant
383 if Compile_Time_Known_Value
(Right_Opnd
) then
385 R
:= Expr_Value
(Right_Opnd
);
387 -- Case of left operand is a constant
389 elsif Compile_Time_Known_Value
(Left_Opnd
) then
391 R
:= Expr_Value
(Left_Opnd
);
393 -- Neither operand is a constant, do the multiply with no optimization
396 return Make_Op_Multiply
(Loc
, Left_Opnd
, Right_Opnd
);
399 -- Case of left operand is an multiplication
401 if Nkind
(L
) = N_Op_Multiply
then
403 -- (C1 * E) * C2 = (C1 * C2) + E
405 if Compile_Time_Known_Value
(Sinfo
.Left_Opnd
(L
)) then
407 (Sinfo
.Left_Opnd
(L
),
408 Expr_Value
(Sinfo
.Left_Opnd
(L
)) * R
);
411 -- (E * C1) * C2 = E * (C1 * C2)
413 elsif Compile_Time_Known_Value
(Sinfo
.Right_Opnd
(L
)) then
415 (Sinfo
.Right_Opnd
(L
),
416 Expr_Value
(Sinfo
.Right_Opnd
(L
)) * R
);
421 -- Not optimizable, do the multiplication
423 return Make_Op_Multiply
(Loc
, Left_Opnd
, Right_Opnd
);
430 function Assoc_Subtract
433 Right_Opnd
: Node_Id
)
440 -- Case of right operand is a constant
442 if Compile_Time_Known_Value
(Right_Opnd
) then
444 R
:= Expr_Value
(Right_Opnd
);
446 -- Right operand is a constant, do the subtract with no optimization
449 return Make_Op_Subtract
(Loc
, Left_Opnd
, Right_Opnd
);
452 -- Case of left operand is an addition
454 if Nkind
(L
) = N_Op_Add
then
456 -- (C1 + E) - C2 = (C1 - C2) + E
458 if Compile_Time_Known_Value
(Sinfo
.Left_Opnd
(L
)) then
460 (Sinfo
.Left_Opnd
(L
),
461 Expr_Value
(Sinfo
.Left_Opnd
(L
)) - R
);
464 -- (E + C1) - C2 = E + (C1 - C2)
466 elsif Compile_Time_Known_Value
(Sinfo
.Right_Opnd
(L
)) then
468 (Sinfo
.Right_Opnd
(L
),
469 Expr_Value
(Sinfo
.Right_Opnd
(L
)) - R
);
473 -- Case of left operand is a subtraction
475 elsif Nkind
(L
) = N_Op_Subtract
then
477 -- (C1 - E) - C2 = (C1 - C2) + E
479 if Compile_Time_Known_Value
(Sinfo
.Left_Opnd
(L
)) then
481 (Sinfo
.Left_Opnd
(L
),
482 Expr_Value
(Sinfo
.Left_Opnd
(L
)) + R
);
485 -- (E - C1) - C2 = E - (C1 + C2)
487 elsif Compile_Time_Known_Value
(Sinfo
.Right_Opnd
(L
)) then
489 (Sinfo
.Right_Opnd
(L
),
490 Expr_Value
(Sinfo
.Right_Opnd
(L
)) + R
);
495 -- Not optimizable, do the subtraction
497 return Make_Op_Subtract
(Loc
, Left_Opnd
, Right_Opnd
);
504 function Compute_Length
(Lo
: Node_Id
; Hi
: Node_Id
) return Node_Id
is
505 Loc
: constant Source_Ptr
:= Sloc
(Lo
);
506 Typ
: constant Entity_Id
:= Etype
(Lo
);
511 Lo_Op
:= New_Copy_Tree
(Lo
);
512 Hi_Op
:= New_Copy_Tree
(Hi
);
514 -- If type is enumeration type, then use Pos attribute to convert
515 -- to integer type for which subtraction is a permitted operation.
517 if Is_Enumeration_Type
(Typ
) then
519 Make_Attribute_Reference
(Loc
,
520 Prefix
=> New_Occurrence_Of
(Typ
, Loc
),
521 Attribute_Name
=> Name_Pos
,
522 Expressions
=> New_List
(Lo_Op
));
525 Make_Attribute_Reference
(Loc
,
526 Prefix
=> New_Occurrence_Of
(Typ
, Loc
),
527 Attribute_Name
=> Name_Pos
,
528 Expressions
=> New_List
(Hi_Op
));
536 Right_Opnd
=> Lo_Op
),
537 Right_Opnd
=> Make_Integer_Literal
(Loc
, 1));
540 ----------------------
541 -- Expr_From_SO_Ref --
542 ----------------------
544 function Expr_From_SO_Ref
552 if Is_Dynamic_SO_Ref
(D
) then
553 Ent
:= Get_Dynamic_SO_Entity
(D
);
555 if Is_Discrim_SO_Function
(Ent
) then
557 Make_Function_Call
(Loc
,
558 Name
=> New_Occurrence_Of
(Ent
, Loc
),
559 Parameter_Associations
=> New_List
(
560 Make_Identifier
(Loc
, Chars
=> Vname
)));
563 return New_Occurrence_Of
(Ent
, Loc
);
567 return Make_Integer_Literal
(Loc
, D
);
569 end Expr_From_SO_Ref
;
575 function Get_Max_Size
(E
: Entity_Id
) return Node_Id
is
576 Loc
: constant Source_Ptr
:= Sloc
(E
);
584 type Val_Status_Type
is (Const
, Dynamic
);
586 type Val_Type
(Status
: Val_Status_Type
:= Const
) is
589 when Const
=> Val
: Uint
;
590 when Dynamic
=> Nod
: Node_Id
;
593 -- Shows the status of the value so far. Const means that the value
594 -- is constant, and Val is the current constant value. Dynamic means
595 -- that the value is dynamic, and in this case Nod is the Node_Id of
596 -- the expression to compute the value.
599 -- Calculated value so far if Size.Status = Const,
600 -- or expression value so far if Size.Status = Dynamic.
602 SU_Convert_Required
: Boolean := False;
603 -- This is set to True if the final result must be converted from
604 -- bits to storage units (rounding up to a storage unit boundary).
606 -----------------------
607 -- Local Subprograms --
608 -----------------------
610 procedure Max_Discrim
(N
: in out Node_Id
);
611 -- If the node N represents a discriminant, replace it by the maximum
612 -- value of the discriminant.
614 procedure Min_Discrim
(N
: in out Node_Id
);
615 -- If the node N represents a discriminant, replace it by the minimum
616 -- value of the discriminant.
622 procedure Max_Discrim
(N
: in out Node_Id
) is
624 if Nkind
(N
) = N_Identifier
625 and then Ekind
(Entity
(N
)) = E_Discriminant
627 N
:= Type_High_Bound
(Etype
(N
));
635 procedure Min_Discrim
(N
: in out Node_Id
) is
637 if Nkind
(N
) = N_Identifier
638 and then Ekind
(Entity
(N
)) = E_Discriminant
640 N
:= Type_Low_Bound
(Etype
(N
));
644 -- Start of processing for Get_Max_Size
647 pragma Assert
(Size_Depends_On_Discriminant
(E
));
649 -- Initialize status from component size
651 if Known_Static_Component_Size
(E
) then
652 Size
:= (Const
, Component_Size
(E
));
655 Size
:= (Dynamic
, Expr_From_SO_Ref
(Loc
, Component_Size
(E
)));
658 -- Loop through indices
660 Indx
:= First_Index
(E
);
661 while Present
(Indx
) loop
662 Ityp
:= Etype
(Indx
);
663 Lo
:= Type_Low_Bound
(Ityp
);
664 Hi
:= Type_High_Bound
(Ityp
);
669 -- Value of the current subscript range is statically known
671 if Compile_Time_Known_Value
(Lo
)
672 and then Compile_Time_Known_Value
(Hi
)
674 S
:= Expr_Value
(Hi
) - Expr_Value
(Lo
) + 1;
676 -- If known flat bound, entire size of array is zero!
679 return Make_Integer_Literal
(Loc
, 0);
682 -- Current value is constant, evolve value
684 if Size
.Status
= Const
then
685 Size
.Val
:= Size
.Val
* S
;
687 -- Current value is dynamic
690 -- An interesting little optimization, if we have a pending
691 -- conversion from bits to storage units, and the current
692 -- length is a multiple of the storage unit size, then we
693 -- can take the factor out here statically, avoiding some
694 -- extra dynamic computations at the end.
696 if SU_Convert_Required
and then S
mod SSU
= 0 then
698 SU_Convert_Required
:= False;
703 Left_Opnd
=> Size
.Nod
,
705 Make_Integer_Literal
(Loc
, Intval
=> S
));
708 -- Value of the current subscript range is dynamic
711 -- If the current size value is constant, then here is where we
712 -- make a transition to dynamic values, which are always stored
713 -- in storage units, However, we do not want to convert to SU's
714 -- too soon, consider the case of a packed array of single bits,
715 -- we want to do the SU conversion after computing the size in
718 if Size
.Status
= Const
then
720 -- If the current value is a multiple of the storage unit,
721 -- then most certainly we can do the conversion now, simply
722 -- by dividing the current value by the storage unit value.
723 -- If this works, we set SU_Convert_Required to False.
725 if Size
.Val
mod SSU
= 0 then
728 (Dynamic
, Make_Integer_Literal
(Loc
, Size
.Val
/ SSU
));
729 SU_Convert_Required
:= False;
731 -- Otherwise, we go ahead and convert the value in bits,
732 -- and set SU_Convert_Required to True to ensure that the
733 -- final value is indeed properly converted.
736 Size
:= (Dynamic
, Make_Integer_Literal
(Loc
, Size
.Val
));
737 SU_Convert_Required
:= True;
743 Len
:= Compute_Length
(Lo
, Hi
);
745 -- Check possible range of Len
754 Determine_Range
(Len
, OK
, LLo
, LHi
);
756 Len
:= Convert_To
(Standard_Unsigned
, Len
);
758 -- If we cannot verify that range cannot be super-flat,
759 -- we need a max with zero, since length must be non-neg.
761 if not OK
or else LLo
< 0 then
763 Make_Attribute_Reference
(Loc
,
765 New_Occurrence_Of
(Standard_Unsigned
, Loc
),
766 Attribute_Name
=> Name_Max
,
767 Expressions
=> New_List
(
768 Make_Integer_Literal
(Loc
, 0),
777 -- Here after processing all bounds to set sizes. If the value is
778 -- a constant, then it is bits, and we just return the value.
780 if Size
.Status
= Const
then
781 return Make_Integer_Literal
(Loc
, Size
.Val
);
783 -- Case where the value is dynamic
786 -- Do convert from bits to SU's if needed
788 if SU_Convert_Required
then
790 -- The expression required is (Size.Nod + SU - 1) / SU
796 Left_Opnd
=> Size
.Nod
,
797 Right_Opnd
=> Make_Integer_Literal
(Loc
, SSU
- 1)),
798 Right_Opnd
=> Make_Integer_Literal
(Loc
, SSU
));
805 -----------------------
806 -- Layout_Array_Type --
807 -----------------------
809 procedure Layout_Array_Type
(E
: Entity_Id
) is
810 Loc
: constant Source_Ptr
:= Sloc
(E
);
811 Ctyp
: constant Entity_Id
:= Component_Type
(E
);
819 Insert_Typ
: Entity_Id
;
820 -- This is the type with which any generated constants or functions
821 -- will be associated (i.e. inserted into the freeze actions). This
822 -- is normally the type being layed out. The exception occurs when
823 -- we are laying out Itype's which are local to a record type, and
824 -- whose scope is this record type. Such types do not have freeze
825 -- nodes (because we have no place to put them).
827 ------------------------------------
828 -- How An Array Type is Layed Out --
829 ------------------------------------
831 -- Here is what goes on. We need to multiply the component size of
832 -- the array (which has already been set) by the length of each of
833 -- the indexes. If all these values are known at compile time, then
834 -- the resulting size of the array is the appropriate constant value.
836 -- If the component size or at least one bound is dynamic (but no
837 -- discriminants are present), then the size will be computed as an
838 -- expression that calculates the proper size.
840 -- If there is at least one discriminant bound, then the size is also
841 -- computed as an expression, but this expression contains discriminant
842 -- values which are obtained by selecting from a function parameter, and
843 -- the size is given by a function that is passed the variant record in
844 -- question, and whose body is the expression.
846 type Val_Status_Type
is (Const
, Dynamic
, Discrim
);
848 type Val_Type
(Status
: Val_Status_Type
:= Const
) is
853 -- Calculated value so far if Val_Status = Const
855 when Dynamic | Discrim
=>
857 -- Expression value so far if Val_Status /= Const
861 -- Records the value or expression computed so far. Const means that
862 -- the value is constant, and Val is the current constant value.
863 -- Dynamic means that the value is dynamic, and in this case Nod is
864 -- the Node_Id of the expression to compute the value, and Discrim
865 -- means that at least one bound is a discriminant, in which case Nod
866 -- is the expression so far (which will be the body of the function).
869 -- Value of size computed so far. See comments above.
871 Vtyp
: Entity_Id
:= Empty
;
872 -- Variant record type for the formal parameter of the
873 -- discriminant function V if Status = Discrim.
875 SU_Convert_Required
: Boolean := False;
876 -- This is set to True if the final result must be converted from
877 -- bits to storage units (rounding up to a storage unit boundary).
879 procedure Discrimify
(N
: in out Node_Id
);
880 -- If N represents a discriminant, then the Size.Status is set to
881 -- Discrim, and Vtyp is set. The parameter N is replaced with the
882 -- proper expression to extract the discriminant value from V.
888 procedure Discrimify
(N
: in out Node_Id
) is
893 if Nkind
(N
) = N_Identifier
894 and then Ekind
(Entity
(N
)) = E_Discriminant
896 Set_Size_Depends_On_Discriminant
(E
);
898 if Size
.Status
/= Discrim
then
899 Decl
:= Parent
(Parent
(Entity
(N
)));
900 Size
:= (Discrim
, Size
.Nod
);
901 Vtyp
:= Defining_Identifier
(Decl
);
907 Make_Selected_Component
(Loc
,
908 Prefix
=> Make_Identifier
(Loc
, Chars
=> Vname
),
909 Selector_Name
=> New_Occurrence_Of
(Entity
(N
), Loc
));
911 -- Set the Etype attributes of the selected name and its prefix.
912 -- Analyze_And_Resolve can't be called here because the Vname
913 -- entity denoted by the prefix will not yet exist (it's created
914 -- by SO_Ref_From_Expr, called at the end of Layout_Array_Type).
916 Set_Etype
(Prefix
(N
), Vtyp
);
921 -- Start of processing for Layout_Array_Type
924 -- Default alignment is component alignment
926 if Unknown_Alignment
(E
) then
927 Set_Alignment
(E
, Alignment
(Ctyp
));
930 -- Calculate proper type for insertions
932 if Is_Record_Type
(Scope
(E
)) then
933 Insert_Typ
:= Scope
(E
);
938 -- Deal with component size if base type
940 if Ekind
(E
) = E_Array_Type
then
942 -- Cannot do anything if Esize of component type unknown
944 if Unknown_Esize
(Ctyp
) then
948 -- Set component size if not set already
950 if Unknown_Component_Size
(E
) then
951 Set_Component_Size
(E
, Esize
(Ctyp
));
955 -- (RM 13.3 (48)) says that the size of an unconstrained array
956 -- is implementation defined. We choose to leave it as Unknown
957 -- here, and the actual behavior is determined by the back end.
959 if not Is_Constrained
(E
) then
963 -- Initialize status from component size
965 if Known_Static_Component_Size
(E
) then
966 Size
:= (Const
, Component_Size
(E
));
969 Size
:= (Dynamic
, Expr_From_SO_Ref
(Loc
, Component_Size
(E
)));
972 -- Loop to process array indices
974 Indx
:= First_Index
(E
);
975 while Present
(Indx
) loop
976 Ityp
:= Etype
(Indx
);
977 Lo
:= Type_Low_Bound
(Ityp
);
978 Hi
:= Type_High_Bound
(Ityp
);
980 -- Value of the current subscript range is statically known
982 if Compile_Time_Known_Value
(Lo
)
983 and then Compile_Time_Known_Value
(Hi
)
985 S
:= Expr_Value
(Hi
) - Expr_Value
(Lo
) + 1;
987 -- If known flat bound, entire size of array is zero!
990 Set_Esize
(E
, Uint_0
);
991 Set_RM_Size
(E
, Uint_0
);
995 -- If constant, evolve value
997 if Size
.Status
= Const
then
998 Size
.Val
:= Size
.Val
* S
;
1000 -- Current value is dynamic
1003 -- An interesting little optimization, if we have a pending
1004 -- conversion from bits to storage units, and the current
1005 -- length is a multiple of the storage unit size, then we
1006 -- can take the factor out here statically, avoiding some
1007 -- extra dynamic computations at the end.
1009 if SU_Convert_Required
and then S
mod SSU
= 0 then
1011 SU_Convert_Required
:= False;
1014 -- Now go ahead and evolve the expression
1017 Assoc_Multiply
(Loc
,
1018 Left_Opnd
=> Size
.Nod
,
1020 Make_Integer_Literal
(Loc
, Intval
=> S
));
1023 -- Value of the current subscript range is dynamic
1026 -- If the current size value is constant, then here is where we
1027 -- make a transition to dynamic values, which are always stored
1028 -- in storage units, However, we do not want to convert to SU's
1029 -- too soon, consider the case of a packed array of single bits,
1030 -- we want to do the SU conversion after computing the size in
1033 if Size
.Status
= Const
then
1035 -- If the current value is a multiple of the storage unit,
1036 -- then most certainly we can do the conversion now, simply
1037 -- by dividing the current value by the storage unit value.
1038 -- If this works, we set SU_Convert_Required to False.
1040 if Size
.Val
mod SSU
= 0 then
1042 (Dynamic
, Make_Integer_Literal
(Loc
, Size
.Val
/ SSU
));
1043 SU_Convert_Required
:= False;
1045 -- Otherwise, we go ahead and convert the value in bits,
1046 -- and set SU_Convert_Required to True to ensure that the
1047 -- final value is indeed properly converted.
1050 Size
:= (Dynamic
, Make_Integer_Literal
(Loc
, Size
.Val
));
1051 SU_Convert_Required
:= True;
1058 -- Length is hi-lo+1
1060 Len
:= Compute_Length
(Lo
, Hi
);
1062 -- Check possible range of Len
1070 Set_Parent
(Len
, E
);
1071 Determine_Range
(Len
, OK
, LLo
, LHi
);
1073 Len
:= Convert_To
(Standard_Unsigned
, Len
);
1075 -- If range definitely flat or superflat, result size is zero
1077 if OK
and then LHi
<= 0 then
1078 Set_Esize
(E
, Uint_0
);
1079 Set_RM_Size
(E
, Uint_0
);
1083 -- If we cannot verify that range cannot be super-flat, we
1084 -- need a maximum with zero, since length cannot be negative.
1086 if not OK
or else LLo
< 0 then
1088 Make_Attribute_Reference
(Loc
,
1090 New_Occurrence_Of
(Standard_Unsigned
, Loc
),
1091 Attribute_Name
=> Name_Max
,
1092 Expressions
=> New_List
(
1093 Make_Integer_Literal
(Loc
, 0),
1098 -- At this stage, Len has the expression for the length
1101 Assoc_Multiply
(Loc
,
1102 Left_Opnd
=> Size
.Nod
,
1109 -- Here after processing all bounds to set sizes. If the value is
1110 -- a constant, then it is bits, and the only thing we need to do
1111 -- is to check against explicit given size and do alignment adjust.
1113 if Size
.Status
= Const
then
1114 Set_And_Check_Static_Size
(E
, Size
.Val
, Size
.Val
);
1115 Adjust_Esize_Alignment
(E
);
1117 -- Case where the value is dynamic
1120 -- Do convert from bits to SU's if needed
1122 if SU_Convert_Required
then
1124 -- The expression required is (Size.Nod + SU - 1) / SU
1127 Make_Op_Divide
(Loc
,
1130 Left_Opnd
=> Size
.Nod
,
1131 Right_Opnd
=> Make_Integer_Literal
(Loc
, SSU
- 1)),
1132 Right_Opnd
=> Make_Integer_Literal
(Loc
, SSU
));
1135 -- Now set the dynamic size (the Value_Size is always the same
1136 -- as the Object_Size for arrays whose length is dynamic).
1138 -- ??? If Size.Status = Dynamic, Vtyp will not have been set.
1139 -- The added initialization sets it to Empty now, but is this
1142 Set_Esize
(E
, SO_Ref_From_Expr
(Size
.Nod
, Insert_Typ
, Vtyp
));
1143 Set_RM_Size
(E
, Esize
(E
));
1145 end Layout_Array_Type
;
1151 procedure Layout_Object
(E
: Entity_Id
) is
1152 T
: constant Entity_Id
:= Etype
(E
);
1155 -- Nothing to do if backend does layout
1157 if not Frontend_Layout_On_Target
then
1161 -- Set size if not set for object and known for type. Use the
1162 -- RM_Size if that is known for the type and Esize is not.
1164 if Unknown_Esize
(E
) then
1165 if Known_Esize
(T
) then
1166 Set_Esize
(E
, Esize
(T
));
1168 elsif Known_RM_Size
(T
) then
1169 Set_Esize
(E
, RM_Size
(T
));
1173 -- Set alignment from type if unknown and type alignment known
1175 if Unknown_Alignment
(E
) and then Known_Alignment
(T
) then
1176 Set_Alignment
(E
, Alignment
(T
));
1179 -- Make sure size and alignment are consistent
1181 Adjust_Esize_Alignment
(E
);
1183 -- Final adjustment, if we don't know the alignment, and the Esize
1184 -- was not set by an explicit Object_Size attribute clause, then
1185 -- we reset the Esize to unknown, since we really don't know it.
1187 if Unknown_Alignment
(E
)
1188 and then not Has_Size_Clause
(E
)
1190 Set_Esize
(E
, Uint_0
);
1194 ------------------------
1195 -- Layout_Record_Type --
1196 ------------------------
1198 procedure Layout_Record_Type
(E
: Entity_Id
) is
1199 Loc
: constant Source_Ptr
:= Sloc
(E
);
1203 -- Current component being layed out
1205 Prev_Comp
: Entity_Id
;
1206 -- Previous layed out component
1208 procedure Get_Next_Component_Location
1209 (Prev_Comp
: Entity_Id
;
1211 New_Npos
: out SO_Ref
;
1212 New_Fbit
: out SO_Ref
;
1213 New_NPMax
: out SO_Ref
;
1214 Force_SU
: Boolean);
1215 -- Given the previous component in Prev_Comp, which is already laid
1216 -- out, and the alignment of the following component, lays out the
1217 -- following component, and returns its starting position in New_Npos
1218 -- (Normalized_Position value), New_Fbit (Normalized_First_Bit value),
1219 -- and New_NPMax (Normalized_Position_Max value). If Prev_Comp is empty
1220 -- (no previous component is present), then New_Npos, New_Fbit and
1221 -- New_NPMax are all set to zero on return. This procedure is also
1222 -- used to compute the size of a record or variant by giving it the
1223 -- last component, and the record alignment. Force_SU is used to force
1224 -- the new component location to be aligned on a storage unit boundary,
1225 -- even in a packed record, False means that the new position does not
1226 -- need to be bumped to a storage unit boundary, True means a storage
1227 -- unit boundary is always required.
1229 procedure Layout_Component
(Comp
: Entity_Id
; Prev_Comp
: Entity_Id
);
1230 -- Lays out component Comp, given Prev_Comp, the previously laid-out
1231 -- component (Prev_Comp = Empty if no components laid out yet). The
1232 -- alignment of the record itself is also updated if needed. Both
1233 -- Comp and Prev_Comp can be either components or discriminants. A
1234 -- special case is when Comp is Empty, this is used at the end
1235 -- to determine the size of the entire record. For this special
1236 -- call the resulting offset is placed in Final_Offset.
1238 procedure Layout_Components
1242 RM_Siz
: out SO_Ref
);
1243 -- This procedure lays out the components of the given component list
1244 -- which contains the components starting with From, and ending with To.
1245 -- The Next_Entity chain is used to traverse the components. On entry
1246 -- Prev_Comp is set to the component preceding the list, so that the
1247 -- list is layed out after this component. Prev_Comp is set to Empty if
1248 -- the component list is to be layed out starting at the start of the
1249 -- record. On return, the components are all layed out, and Prev_Comp is
1250 -- set to the last layed out component. On return, Esiz is set to the
1251 -- resulting Object_Size value, which is the length of the record up
1252 -- to and including the last layed out entity. For Esiz, the value is
1253 -- adjusted to match the alignment of the record. RM_Siz is similarly
1254 -- set to the resulting Value_Size value, which is the same length, but
1255 -- not adjusted to meet the alignment. Note that in the case of variant
1256 -- records, Esiz represents the maximum size.
1258 procedure Layout_Non_Variant_Record
;
1259 -- Procedure called to layout a non-variant record type or subtype
1261 procedure Layout_Variant_Record
;
1262 -- Procedure called to layout a variant record type. Decl is set to the
1263 -- full type declaration for the variant record.
1265 ---------------------------------
1266 -- Get_Next_Component_Location --
1267 ---------------------------------
1269 procedure Get_Next_Component_Location
1270 (Prev_Comp
: Entity_Id
;
1272 New_Npos
: out SO_Ref
;
1273 New_Fbit
: out SO_Ref
;
1274 New_NPMax
: out SO_Ref
;
1278 -- No previous component, return zero position
1280 if No
(Prev_Comp
) then
1283 New_NPMax
:= Uint_0
;
1287 -- Here we have a previous component
1290 Loc
: constant Source_Ptr
:= Sloc
(Prev_Comp
);
1292 Old_Npos
: constant SO_Ref
:= Normalized_Position
(Prev_Comp
);
1293 Old_Fbit
: constant SO_Ref
:= Normalized_First_Bit
(Prev_Comp
);
1294 Old_NPMax
: constant SO_Ref
:= Normalized_Position_Max
(Prev_Comp
);
1295 Old_Esiz
: constant SO_Ref
:= Esize
(Prev_Comp
);
1297 Old_Maxsz
: Node_Id
;
1298 -- Expression representing maximum size of previous component
1301 -- Case where previous field had a dynamic size
1303 if Is_Dynamic_SO_Ref
(Esize
(Prev_Comp
)) then
1305 -- If the previous field had a dynamic length, then it is
1306 -- required to occupy an integral number of storage units,
1307 -- and start on a storage unit boundary. This means that
1308 -- the Normalized_First_Bit value is zero in the previous
1309 -- component, and the new value is also set to zero.
1313 -- In this case, the new position is given by an expression
1314 -- that is the sum of old normalized position and old size.
1319 Left_Opnd
=> Expr_From_SO_Ref
(Loc
, Old_Npos
),
1320 Right_Opnd
=> Expr_From_SO_Ref
(Loc
, Old_Esiz
)),
1324 -- Get maximum size of previous component
1326 if Size_Depends_On_Discriminant
(Etype
(Prev_Comp
)) then
1327 Old_Maxsz
:= Get_Max_Size
(Etype
(Prev_Comp
));
1329 Old_Maxsz
:= Expr_From_SO_Ref
(Loc
, Old_Esiz
);
1332 -- Now we can compute the new max position. If the max size
1333 -- is static and the old position is static, then we can
1334 -- compute the new position statically.
1336 if Nkind
(Old_Maxsz
) = N_Integer_Literal
1337 and then Known_Static_Normalized_Position_Max
(Prev_Comp
)
1339 New_NPMax
:= Old_NPMax
+ Intval
(Old_Maxsz
);
1341 -- Otherwise new max position is dynamic
1347 Left_Opnd
=> Expr_From_SO_Ref
(Loc
, Old_NPMax
),
1348 Right_Opnd
=> Old_Maxsz
),
1353 -- Previous field has known static Esize
1356 New_Fbit
:= Old_Fbit
+ Old_Esiz
;
1358 -- Bump New_Fbit to storage unit boundary if required
1360 if New_Fbit
/= 0 and then Force_SU
then
1361 New_Fbit
:= (New_Fbit
+ SSU
- 1) / SSU
* SSU
;
1364 -- If old normalized position is static, we can go ahead
1365 -- and compute the new normalized position directly.
1367 if Known_Static_Normalized_Position
(Prev_Comp
) then
1368 New_Npos
:= Old_Npos
;
1370 if New_Fbit
>= SSU
then
1371 New_Npos
:= New_Npos
+ New_Fbit
/ SSU
;
1372 New_Fbit
:= New_Fbit
mod SSU
;
1375 -- Bump alignment if stricter than prev
1377 if Align
> Alignment
(Prev_Comp
) then
1378 New_Npos
:= (New_Npos
+ Align
- 1) / Align
* Align
;
1381 -- The max position is always equal to the position if
1382 -- the latter is static, since arrays depending on the
1383 -- values of discriminants never have static sizes.
1385 New_NPMax
:= New_Npos
;
1388 -- Case of old normalized position is dynamic
1391 -- If new bit position is within the current storage unit,
1392 -- we can just copy the old position as the result position
1393 -- (we have already set the new first bit value).
1395 if New_Fbit
< SSU
then
1396 New_Npos
:= Old_Npos
;
1397 New_NPMax
:= Old_NPMax
;
1399 -- If new bit position is past the current storage unit, we
1400 -- need to generate a new dynamic value for the position
1401 -- ??? need to deal with alignment
1407 Left_Opnd
=> Expr_From_SO_Ref
(Loc
, Old_Npos
),
1409 Make_Integer_Literal
(Loc
,
1410 Intval
=> New_Fbit
/ SSU
)),
1417 Left_Opnd
=> Expr_From_SO_Ref
(Loc
, Old_NPMax
),
1419 Make_Integer_Literal
(Loc
,
1420 Intval
=> New_Fbit
/ SSU
)),
1423 New_Fbit
:= New_Fbit
mod SSU
;
1428 end Get_Next_Component_Location
;
1430 ----------------------
1431 -- Layout_Component --
1432 ----------------------
1434 procedure Layout_Component
(Comp
: Entity_Id
; Prev_Comp
: Entity_Id
) is
1435 Ctyp
: constant Entity_Id
:= Etype
(Comp
);
1442 -- Parent field is always at start of record, this will overlap
1443 -- the actual fields that are part of the parent, and that's fine
1445 if Chars
(Comp
) = Name_uParent
then
1446 Set_Normalized_Position
(Comp
, Uint_0
);
1447 Set_Normalized_First_Bit
(Comp
, Uint_0
);
1448 Set_Normalized_Position_Max
(Comp
, Uint_0
);
1449 Set_Component_Bit_Offset
(Comp
, Uint_0
);
1450 Set_Esize
(Comp
, Esize
(Ctyp
));
1454 -- Check case of type of component has a scope of the record we
1455 -- are laying out. When this happens, the type in question is an
1456 -- Itype that has not yet been layed out (that's because such
1457 -- types do not get frozen in the normal manner, because there
1458 -- is no place for the freeze nodes).
1460 if Scope
(Ctyp
) = E
then
1464 -- Increase alignment of record if necessary. Note that we do not
1465 -- do this for packed records, which have an alignment of one by
1466 -- default, or for records for which an explicit alignment was
1467 -- specified with an alignment clause.
1469 if not Is_Packed
(E
)
1470 and then not Has_Alignment_Clause
(E
)
1471 and then Alignment
(Ctyp
) > Alignment
(E
)
1473 Set_Alignment
(E
, Alignment
(Ctyp
));
1476 -- If component already laid out, then we are done
1478 if Known_Normalized_Position
(Comp
) then
1482 -- Set size of component from type. We use the Esize except in a
1483 -- packed record, where we use the RM_Size (since that is exactly
1484 -- what the RM_Size value, as distinct from the Object_Size is
1487 if Is_Packed
(E
) then
1488 Set_Esize
(Comp
, RM_Size
(Ctyp
));
1490 Set_Esize
(Comp
, Esize
(Ctyp
));
1493 -- Compute the component position from the previous one. See if
1494 -- current component requires being on a storage unit boundary.
1496 -- If record is not packed, we always go to a storage unit boundary
1498 if not Is_Packed
(E
) then
1504 -- Elementary types do not need SU boundary in packed record
1506 if Is_Elementary_Type
(Ctyp
) then
1509 -- Packed array types with a modular packed array type do not
1510 -- force a storage unit boundary (since the code generation
1511 -- treats these as equivalent to the underlying modular type),
1513 elsif Is_Array_Type
(Ctyp
)
1514 and then Is_Bit_Packed_Array
(Ctyp
)
1515 and then Is_Modular_Integer_Type
(Packed_Array_Type
(Ctyp
))
1519 -- Record types with known length less than or equal to the length
1520 -- of long long integer can also be unaligned, since they can be
1521 -- treated as scalars.
1523 elsif Is_Record_Type
(Ctyp
)
1524 and then not Is_Dynamic_SO_Ref
(Esize
(Ctyp
))
1525 and then Esize
(Ctyp
) <= Esize
(Standard_Long_Long_Integer
)
1529 -- All other cases force a storage unit boundary, even when packed
1536 -- Now get the next component location
1538 Get_Next_Component_Location
1539 (Prev_Comp
, Alignment
(Ctyp
), Npos
, Fbit
, NPMax
, Forc
);
1540 Set_Normalized_Position
(Comp
, Npos
);
1541 Set_Normalized_First_Bit
(Comp
, Fbit
);
1542 Set_Normalized_Position_Max
(Comp
, NPMax
);
1544 -- Set Component_Bit_Offset in the static case
1546 if Known_Static_Normalized_Position
(Comp
)
1547 and then Known_Normalized_First_Bit
(Comp
)
1549 Set_Component_Bit_Offset
(Comp
, SSU
* Npos
+ Fbit
);
1551 end Layout_Component
;
1553 -----------------------
1554 -- Layout_Components --
1555 -----------------------
1557 procedure Layout_Components
1561 RM_Siz
: out SO_Ref
)
1568 -- Only layout components if there are some to layout!
1570 if Present
(From
) then
1572 -- Layout components with no component clauses
1576 if (Ekind
(Comp
) = E_Component
1577 or else Ekind
(Comp
) = E_Discriminant
)
1578 and then No
(Component_Clause
(Comp
))
1580 Layout_Component
(Comp
, Prev_Comp
);
1584 exit when Comp
= To
;
1589 -- Set size fields, both are zero if no components
1591 if No
(Prev_Comp
) then
1596 -- First the object size, for which we align past the last
1597 -- field to the alignment of the record (the object size
1598 -- is required to be a multiple of the alignment).
1600 Get_Next_Component_Location
1608 -- If the resulting normalized position is a dynamic reference,
1609 -- then the size is dynamic, and is stored in storage units.
1610 -- In this case, we set the RM_Size to the same value, it is
1611 -- simply not worth distinguishing Esize and RM_Size values in
1612 -- the dynamic case, since the RM has nothing to say about them.
1614 -- Note that a size cannot have been given in this case, since
1615 -- size specifications cannot be given for variable length types.
1618 Align
: constant Uint
:= Alignment
(E
);
1621 if Is_Dynamic_SO_Ref
(End_Npos
) then
1624 -- Set the Object_Size allowing for alignment. In the
1625 -- dynamic case, we have to actually do the runtime
1626 -- computation. We can skip this in the non-packed
1627 -- record case if the last component has a smaller
1628 -- alignment than the overall record alignment.
1630 if Is_Dynamic_SO_Ref
(End_NPMax
) then
1634 or else Alignment
(Prev_Comp
) < Align
1636 -- The expression we build is
1637 -- (expr + align - 1) / align * align
1642 Make_Op_Multiply
(Loc
,
1644 Make_Op_Divide
(Loc
,
1648 Expr_From_SO_Ref
(Loc
, Esiz
),
1650 Make_Integer_Literal
(Loc
,
1651 Intval
=> Align
- 1)),
1653 Make_Integer_Literal
(Loc
, Align
)),
1655 Make_Integer_Literal
(Loc
, Align
)),
1660 -- Here Esiz is static, so we can adjust the alignment
1661 -- directly go give the required aligned value.
1664 Esiz
:= (End_NPMax
+ Align
- 1) / Align
* Align
* SSU
;
1667 -- Case where computed size is static
1670 -- The ending size was computed in Npos in storage units,
1671 -- but the actual size is stored in bits, so adjust
1672 -- accordingly. We also adjust the size to match the
1675 Esiz
:= (End_NPMax
+ Align
- 1) / Align
* Align
* SSU
;
1677 -- Compute the resulting Value_Size (RM_Size). For this
1678 -- purpose we do not force alignment of the record or
1679 -- storage size alignment of the result.
1681 Get_Next_Component_Location
1689 RM_Siz
:= End_Npos
* SSU
+ End_Fbit
;
1690 Set_And_Check_Static_Size
(E
, Esiz
, RM_Siz
);
1694 end Layout_Components
;
1696 -------------------------------
1697 -- Layout_Non_Variant_Record --
1698 -------------------------------
1700 procedure Layout_Non_Variant_Record
is
1705 Layout_Components
(First_Entity
(E
), Last_Entity
(E
), Esiz
, RM_Siz
);
1706 Set_Esize
(E
, Esiz
);
1707 Set_RM_Size
(E
, RM_Siz
);
1708 end Layout_Non_Variant_Record
;
1710 ---------------------------
1711 -- Layout_Variant_Record --
1712 ---------------------------
1714 procedure Layout_Variant_Record
is
1715 Tdef
: constant Node_Id
:= Type_Definition
(Decl
);
1716 Dlist
: constant List_Id
:= Discriminant_Specifications
(Decl
);
1720 RM_Siz_Expr
: Node_Id
:= Empty
;
1721 -- Expression for the evolving RM_Siz value. This is typically a
1722 -- conditional expression which involves tests of discriminant
1723 -- values that are formed as references to the entity V. At
1724 -- the end of scanning all the components, a suitable function
1725 -- is constructed in which V is the parameter.
1727 -----------------------
1728 -- Local Subprograms --
1729 -----------------------
1731 procedure Layout_Component_List
1734 RM_Siz_Expr
: out Node_Id
);
1735 -- Recursive procedure, called to layout one component list
1736 -- Esiz and RM_Siz_Expr are set to the Object_Size and Value_Size
1737 -- values respectively representing the record size up to and
1738 -- including the last component in the component list (including
1739 -- any variants in this component list). RM_Siz_Expr is returned
1740 -- as an expression which may in the general case involve some
1741 -- references to the discriminants of the current record value,
1742 -- referenced by selecting from the entity V.
1744 ---------------------------
1745 -- Layout_Component_List --
1746 ---------------------------
1748 procedure Layout_Component_List
1751 RM_Siz_Expr
: out Node_Id
)
1753 Citems
: constant List_Id
:= Component_Items
(Clist
);
1754 Vpart
: constant Node_Id
:= Variant_Part
(Clist
);
1758 RMS_Ent
: Entity_Id
;
1761 if Is_Non_Empty_List
(Citems
) then
1763 (From
=> Defining_Identifier
(First
(Citems
)),
1764 To
=> Defining_Identifier
(Last
(Citems
)),
1768 Layout_Components
(Empty
, Empty
, Esiz
, RM_Siz
);
1771 -- Case where no variants are present in the component list
1775 -- The Esiz value has been correctly set by the call to
1776 -- Layout_Components, so there is nothing more to be done.
1778 -- For RM_Siz, we have an SO_Ref value, which we must convert
1779 -- to an appropriate expression.
1781 if Is_Static_SO_Ref
(RM_Siz
) then
1783 Make_Integer_Literal
(Loc
,
1787 RMS_Ent
:= Get_Dynamic_SO_Entity
(RM_Siz
);
1789 -- If the size is represented by a function, then we
1790 -- create an appropriate function call using V as
1791 -- the parameter to the call.
1793 if Is_Discrim_SO_Function
(RMS_Ent
) then
1795 Make_Function_Call
(Loc
,
1796 Name
=> New_Occurrence_Of
(RMS_Ent
, Loc
),
1797 Parameter_Associations
=> New_List
(
1798 Make_Identifier
(Loc
, Chars
=> Vname
)));
1800 -- If the size is represented by a constant, then the
1801 -- expression we want is a reference to this constant
1804 RM_Siz_Expr
:= New_Occurrence_Of
(RMS_Ent
, Loc
);
1808 -- Case where variants are present in this component list
1819 RM_Siz_Expr
:= Empty
;
1822 Var
:= Last
(Variants
(Vpart
));
1823 while Present
(Var
) loop
1825 Layout_Component_List
1826 (Component_List
(Var
), EsizV
, RM_SizV
);
1828 -- Set the Object_Size. If this is the first variant,
1829 -- we just set the size of this first variant.
1831 if Var
= Last
(Variants
(Vpart
)) then
1834 -- Otherwise the Object_Size is formed as a maximum
1835 -- of Esiz so far from previous variants, and the new
1836 -- Esiz value from the variant we just processed.
1838 -- If both values are static, we can just compute the
1839 -- maximum directly to save building junk nodes.
1841 elsif not Is_Dynamic_SO_Ref
(Esiz
)
1842 and then not Is_Dynamic_SO_Ref
(EsizV
)
1844 Esiz
:= UI_Max
(Esiz
, EsizV
);
1846 -- If either value is dynamic, then we have to generate
1847 -- an appropriate Standard_Unsigned'Max attribute call.
1852 (Make_Attribute_Reference
(Loc
,
1853 Attribute_Name
=> Name_Max
,
1855 New_Occurrence_Of
(Standard_Unsigned
, Loc
),
1856 Expressions
=> New_List
(
1857 Expr_From_SO_Ref
(Loc
, Esiz
),
1858 Expr_From_SO_Ref
(Loc
, EsizV
))),
1863 -- Now deal with Value_Size (RM_Siz). We are aiming at
1864 -- an expression that looks like:
1866 -- if xxDx (V.disc) then rmsiz1
1867 -- else if xxDx (V.disc) then rmsiz2
1870 -- Where rmsiz1, rmsiz2... are the RM_Siz values for the
1871 -- individual variants, and xxDx are the discriminant
1872 -- checking functions generated for the variant type.
1874 -- If this is the first variant, we simply set the
1875 -- result as the expression. Note that this takes
1876 -- care of the others case.
1878 if No
(RM_Siz_Expr
) then
1879 RM_Siz_Expr
:= RM_SizV
;
1881 -- Otherwise construct the appropriate test
1884 -- Discriminant to be tested
1887 Make_Selected_Component
(Loc
,
1889 Make_Identifier
(Loc
, Chars
=> Vname
),
1892 (Entity
(Name
(Vpart
)), Loc
));
1894 -- The test to be used in general is a call to the
1895 -- discriminant checking function. However, it is
1896 -- definitely worth special casing the very common
1897 -- case where a single value is involved.
1899 Dchoice
:= First
(Discrete_Choices
(Var
));
1901 if No
(Next
(Dchoice
))
1902 and then Nkind
(Dchoice
) /= N_Range
1906 Left_Opnd
=> Discrim
,
1907 Right_Opnd
=> New_Copy
(Dchoice
));
1911 Make_Function_Call
(Loc
,
1914 (Dcheck_Function
(Var
), Loc
),
1915 Parameter_Associations
=> New_List
(Discrim
));
1919 Make_Conditional_Expression
(Loc
,
1921 New_List
(Dtest
, RM_SizV
, RM_Siz_Expr
));
1928 end Layout_Component_List
;
1930 -- Start of processing for Layout_Variant_Record
1933 -- We need the discriminant checking functions, since we generate
1934 -- calls to these functions for the RM_Size expression, so make
1935 -- sure that these functions have been constructed in time.
1937 Build_Discr_Checking_Funcs
(Decl
);
1939 -- Layout the discriminants
1942 (From
=> Defining_Identifier
(First
(Dlist
)),
1943 To
=> Defining_Identifier
(Last
(Dlist
)),
1947 -- Layout the main component list (this will make recursive calls
1948 -- to layout all component lists nested within variants).
1950 Layout_Component_List
(Component_List
(Tdef
), Esiz
, RM_Siz_Expr
);
1951 Set_Esize
(E
, Esiz
);
1953 -- If the RM_Size is a literal, set its value
1955 if Nkind
(RM_Siz_Expr
) = N_Integer_Literal
then
1956 Set_RM_Size
(E
, Intval
(RM_Siz_Expr
));
1958 -- Otherwise we construct a dynamic SO_Ref
1967 end Layout_Variant_Record
;
1969 -- Start of processing for Layout_Record_Type
1972 -- If this is a cloned subtype, just copy the size fields from the
1973 -- original, nothing else needs to be done in this case, since the
1974 -- components themselves are all shared.
1976 if (Ekind
(E
) = E_Record_Subtype
1977 or else Ekind
(E
) = E_Class_Wide_Subtype
)
1978 and then Present
(Cloned_Subtype
(E
))
1980 Set_Esize
(E
, Esize
(Cloned_Subtype
(E
)));
1981 Set_RM_Size
(E
, RM_Size
(Cloned_Subtype
(E
)));
1982 Set_Alignment
(E
, Alignment
(Cloned_Subtype
(E
)));
1984 -- Another special case, class-wide types. The RM says that the size
1985 -- of such types is implementation defined (RM 13.3(48)). What we do
1986 -- here is to leave the fields set as unknown values, and the backend
1987 -- determines the actual behavior.
1989 elsif Ekind
(E
) = E_Class_Wide_Type
then
1995 -- Initialize aligment conservatively to 1. This value will
1996 -- be increased as necessary during processing of the record.
1998 if Unknown_Alignment
(E
) then
1999 Set_Alignment
(E
, Uint_1
);
2002 -- Initialize previous component. This is Empty unless there
2003 -- are components which have already been laid out by component
2004 -- clauses. If there are such components, we start our layout of
2005 -- the remaining components following the last such component
2009 Comp
:= First_Entity
(E
);
2010 while Present
(Comp
) loop
2011 if (Ekind
(Comp
) = E_Component
2012 or else Ekind
(Comp
) = E_Discriminant
)
2013 and then Present
(Component_Clause
(Comp
))
2017 Component_Bit_Offset
(Comp
) >
2018 Component_Bit_Offset
(Prev_Comp
)
2027 -- We have two separate circuits, one for non-variant records and
2028 -- one for variant records. For non-variant records, we simply go
2029 -- through the list of components. This handles all the non-variant
2030 -- cases including those cases of subtypes where there is no full
2031 -- type declaration, so the tree cannot be used to drive the layout.
2032 -- For variant records, we have to drive the layout from the tree
2033 -- since we need to understand the variant structure in this case.
2035 if Present
(Full_View
(E
)) then
2036 Decl
:= Declaration_Node
(Full_View
(E
));
2038 Decl
:= Declaration_Node
(E
);
2041 -- Scan all the components
2043 if Nkind
(Decl
) = N_Full_Type_Declaration
2044 and then Has_Discriminants
(E
)
2045 and then Nkind
(Type_Definition
(Decl
)) = N_Record_Definition
2047 Present
(Variant_Part
(Component_List
(Type_Definition
(Decl
))))
2049 Layout_Variant_Record
;
2051 Layout_Non_Variant_Record
;
2054 end Layout_Record_Type
;
2060 procedure Layout_Type
(E
: Entity_Id
) is
2062 -- For string literal types, for now, kill the size always, this
2063 -- is because gigi does not like or need the size to be set ???
2065 if Ekind
(E
) = E_String_Literal_Subtype
then
2066 Set_Esize
(E
, Uint_0
);
2067 Set_RM_Size
(E
, Uint_0
);
2071 -- For access types, set size/alignment. This is system address
2072 -- size, except for fat pointers (unconstrained array access types),
2073 -- where the size is two times the address size, to accommodate the
2074 -- two pointers that are required for a fat pointer (data and
2075 -- template). Note that E_Access_Protected_Subprogram_Type is not
2076 -- an access type for this purpose since it is not a pointer but is
2077 -- equivalent to a record. For access subtypes, copy the size from
2078 -- the base type since Gigi represents them the same way.
2080 if Is_Access_Type
(E
) then
2082 -- If Esize already set (e.g. by a size clause), then nothing
2083 -- further to be done here.
2085 if Known_Esize
(E
) then
2088 -- Access to subprogram is a strange beast, and we let the
2089 -- backend figure out what is needed (it may be some kind
2090 -- of fat pointer, including the static link for example.
2092 elsif Ekind
(E
) = E_Access_Protected_Subprogram_Type
then
2095 -- For access subtypes, copy the size information from base type
2097 elsif Ekind
(E
) = E_Access_Subtype
then
2098 Set_Size_Info
(E
, Base_Type
(E
));
2099 Set_RM_Size
(E
, RM_Size
(Base_Type
(E
)));
2101 -- For other access types, we use either address size, or, if
2102 -- a fat pointer is used (pointer-to-unconstrained array case),
2103 -- twice the address size to accommodate a fat pointer.
2107 Desig
: Entity_Id
:= Designated_Type
(E
);
2110 if Is_Private_Type
(Desig
)
2111 and then Present
(Full_View
(Desig
))
2113 Desig
:= Full_View
(Desig
);
2116 if (Is_Array_Type
(Desig
)
2117 and then not Is_Constrained
(Desig
)
2118 and then not Has_Completion_In_Body
(Desig
)
2119 and then not Debug_Flag_6
)
2121 Init_Size
(E
, 2 * System_Address_Size
);
2123 -- Check for bad convention set
2125 if Convention
(E
) = Convention_C
2127 Convention
(E
) = Convention_CPP
2130 ("?this access type does not " &
2131 "correspond to C pointer", E
);
2135 Init_Size
(E
, System_Address_Size
);
2140 Set_Prim_Alignment
(E
);
2142 -- Scalar types: set size and alignment
2144 elsif Is_Scalar_Type
(E
) then
2146 -- For discrete types, the RM_Size and Esize must be set
2147 -- already, since this is part of the earlier processing
2148 -- and the front end is always required to layout the
2149 -- sizes of such types (since they are available as static
2150 -- attributes). All we do is to check that this rule is
2153 if Is_Discrete_Type
(E
) then
2155 -- If the RM_Size is not set, then here is where we set it.
2157 -- Note: an RM_Size of zero looks like not set here, but this
2158 -- is a rare case, and we can simply reset it without any harm.
2160 if not Known_RM_Size
(E
) then
2161 Set_Discrete_RM_Size
(E
);
2164 -- If Esize for a discrete type is not set then set it
2166 if not Known_Esize
(E
) then
2172 -- If size is big enough, set it and exit
2174 if S
>= RM_Size
(E
) then
2178 -- If the RM_Size is greater than 64 (happens only
2179 -- when strange values are specified by the user,
2180 -- then Esize is simply a copy of RM_Size, it will
2181 -- be further refined later on)
2184 Set_Esize
(E
, RM_Size
(E
));
2187 -- Otherwise double possible size and keep trying
2196 -- For non-discrete sclar types, if the RM_Size is not set,
2197 -- then set it now to a copy of the Esize if the Esize is set.
2200 if Known_Esize
(E
) and then Unknown_RM_Size
(E
) then
2201 Set_RM_Size
(E
, Esize
(E
));
2205 Set_Prim_Alignment
(E
);
2207 -- Non-primitive types
2210 -- If RM_Size is known, set Esize if not known
2212 if Known_RM_Size
(E
) and then Unknown_Esize
(E
) then
2214 -- If the alignment is known, we bump the Esize up to the
2215 -- next alignment boundary if it is not already on one.
2217 if Known_Alignment
(E
) then
2219 A
: constant Uint
:= Alignment_In_Bits
(E
);
2220 S
: constant SO_Ref
:= RM_Size
(E
);
2223 Set_Esize
(E
, (S
* A
+ A
- 1) / A
);
2227 -- If Esize is set, and RM_Size is not, RM_Size is copied from
2228 -- Esize at least for now this seems reasonable, and is in any
2229 -- case needed for compatibility with old versions of gigi.
2230 -- look to be unknown.
2232 elsif Known_Esize
(E
) and then Unknown_RM_Size
(E
) then
2233 Set_RM_Size
(E
, Esize
(E
));
2236 -- For array base types, set component size if object size of
2237 -- the component type is known and is a small power of 2 (8,
2238 -- 16, 32, 64), since this is what will always be used.
2240 if Ekind
(E
) = E_Array_Type
2241 and then Unknown_Component_Size
(E
)
2244 CT
: constant Entity_Id
:= Component_Type
(E
);
2247 -- For some reasons, access types can cause trouble,
2248 -- So let's just do this for discrete types ???
2251 and then Is_Discrete_Type
(CT
)
2252 and then Known_Static_Esize
(CT
)
2255 S
: constant Uint
:= Esize
(CT
);
2263 Set_Component_Size
(E
, Esize
(CT
));
2271 -- Layout array and record types if front end layout set
2273 if Frontend_Layout_On_Target
then
2274 if Is_Array_Type
(E
) and then not Is_Bit_Packed_Array
(E
) then
2275 Layout_Array_Type
(E
);
2277 elsif Is_Record_Type
(E
) then
2278 Layout_Record_Type
(E
);
2282 -- Special remaining processing for record types with a known size
2283 -- of 16, 32, or 64 bits whose alignment is not yet set. For these
2284 -- types, we set a corresponding alignment matching the size if
2285 -- possible, or as large as possible if not.
2287 elsif Is_Record_Type
(E
) and not Debug_Flag_Q
then
2288 Set_Composite_Alignment
(E
);
2290 -- For arrays, we only do this processing for arrays that are
2291 -- required to be atomic. Here, we really need to have proper
2292 -- alignment, but for the normal case of non-atomic arrays it
2293 -- seems better to use the component alignment as the default.
2295 elsif Is_Array_Type
(E
)
2296 and then Is_Atomic
(E
)
2297 and then not Debug_Flag_Q
2299 Set_Composite_Alignment
(E
);
2303 ---------------------
2304 -- Rewrite_Integer --
2305 ---------------------
2307 procedure Rewrite_Integer
(N
: Node_Id
; V
: Uint
) is
2308 Loc
: constant Source_Ptr
:= Sloc
(N
);
2309 Typ
: constant Entity_Id
:= Etype
(N
);
2312 Rewrite
(N
, Make_Integer_Literal
(Loc
, Intval
=> V
));
2314 end Rewrite_Integer
;
2316 -------------------------------
2317 -- Set_And_Check_Static_Size --
2318 -------------------------------
2320 procedure Set_And_Check_Static_Size
2327 procedure Check_Size_Too_Small
(Spec
: Uint
; Min
: Uint
);
2328 -- Spec is the number of bit specified in the size clause, and
2329 -- Min is the minimum computed size. An error is given that the
2330 -- specified size is too small if Spec < Min, and in this case
2331 -- both Esize and RM_Size are set to unknown in E. The error
2332 -- message is posted on node SC.
2334 procedure Check_Unused_Bits
(Spec
: Uint
; Max
: Uint
);
2335 -- Spec is the number of bits specified in the size clause, and
2336 -- Max is the maximum computed size. A warning is given about
2337 -- unused bits if Spec > Max. This warning is posted on node SC.
2339 --------------------------
2340 -- Check_Size_Too_Small --
2341 --------------------------
2343 procedure Check_Size_Too_Small
(Spec
: Uint
; Min
: Uint
) is
2346 Error_Msg_Uint_1
:= Min
;
2348 ("size for & too small, minimum allowed is ^", SC
, E
);
2352 end Check_Size_Too_Small
;
2354 -----------------------
2355 -- Check_Unused_Bits --
2356 -----------------------
2358 procedure Check_Unused_Bits
(Spec
: Uint
; Max
: Uint
) is
2361 Error_Msg_Uint_1
:= Spec
- Max
;
2362 Error_Msg_NE
("?^ bits of & unused", SC
, E
);
2364 end Check_Unused_Bits
;
2366 -- Start of processing for Set_And_Check_Static_Size
2369 -- Case where Object_Size (Esize) is already set by a size clause
2371 if Known_Static_Esize
(E
) then
2372 SC
:= Size_Clause
(E
);
2375 SC
:= Get_Attribute_Definition_Clause
(E
, Attribute_Object_Size
);
2378 -- Perform checks on specified size against computed sizes
2380 if Present
(SC
) then
2381 Check_Unused_Bits
(Esize
(E
), Esiz
);
2382 Check_Size_Too_Small
(Esize
(E
), RM_Siz
);
2386 -- Case where Value_Size (RM_Size) is set by specific Value_Size
2387 -- clause (we do not need to worry about Value_Size being set by
2388 -- a Size clause, since that will have set Esize as well, and we
2389 -- already took care of that case).
2391 if Known_Static_RM_Size
(E
) then
2392 SC
:= Get_Attribute_Definition_Clause
(E
, Attribute_Value_Size
);
2394 -- Perform checks on specified size against computed sizes
2396 if Present
(SC
) then
2397 Check_Unused_Bits
(RM_Size
(E
), Esiz
);
2398 Check_Size_Too_Small
(RM_Size
(E
), RM_Siz
);
2402 -- Set sizes if unknown
2404 if Unknown_Esize
(E
) then
2405 Set_Esize
(E
, Esiz
);
2408 if Unknown_RM_Size
(E
) then
2409 Set_RM_Size
(E
, RM_Siz
);
2411 end Set_And_Check_Static_Size
;
2413 -----------------------------
2414 -- Set_Composite_Alignment --
2415 -----------------------------
2417 procedure Set_Composite_Alignment
(E
: Entity_Id
) is
2422 if Unknown_Alignment
(E
) then
2423 if Known_Static_Esize
(E
) then
2426 elsif Unknown_Esize
(E
)
2427 and then Known_Static_RM_Size
(E
)
2435 -- Size is known, alignment is not set
2437 if Siz
= System_Storage_Unit
then
2439 elsif Siz
= 2 * System_Storage_Unit
then
2441 elsif Siz
= 4 * System_Storage_Unit
then
2443 elsif Siz
= 8 * System_Storage_Unit
then
2449 if Align
> Maximum_Alignment
then
2450 Align
:= Maximum_Alignment
;
2453 if Align
> System_Word_Size
/ System_Storage_Unit
then
2454 Align
:= System_Word_Size
/ System_Storage_Unit
;
2457 Set_Alignment
(E
, UI_From_Int
(Align
));
2459 if Unknown_Esize
(E
) then
2460 Set_Esize
(E
, UI_From_Int
(Align
* System_Storage_Unit
));
2463 end Set_Composite_Alignment
;
2465 --------------------------
2466 -- Set_Discrete_RM_Size --
2467 --------------------------
2469 procedure Set_Discrete_RM_Size
(Def_Id
: Entity_Id
) is
2470 FST
: constant Entity_Id
:= First_Subtype
(Def_Id
);
2473 -- All discrete types except for the base types in standard
2474 -- are constrained, so indicate this by setting Is_Constrained.
2476 Set_Is_Constrained
(Def_Id
);
2478 -- We set generic types to have an unknown size, since the
2479 -- representation of a generic type is irrelevant, in view
2480 -- of the fact that they have nothing to do with code.
2482 if Is_Generic_Type
(Root_Type
(FST
)) then
2483 Set_RM_Size
(Def_Id
, Uint_0
);
2485 -- If the subtype statically matches the first subtype, then
2486 -- it is required to have exactly the same layout. This is
2487 -- required by aliasing considerations.
2489 elsif Def_Id
/= FST
and then
2490 Subtypes_Statically_Match
(Def_Id
, FST
)
2492 Set_RM_Size
(Def_Id
, RM_Size
(FST
));
2493 Set_Size_Info
(Def_Id
, FST
);
2495 -- In all other cases the RM_Size is set to the minimum size.
2496 -- Note that this routine is never called for subtypes for which
2497 -- the RM_Size is set explicitly by an attribute clause.
2500 Set_RM_Size
(Def_Id
, UI_From_Int
(Minimum_Size
(Def_Id
)));
2502 end Set_Discrete_RM_Size
;
2504 ------------------------
2505 -- Set_Prim_Alignment --
2506 ------------------------
2508 procedure Set_Prim_Alignment
(E
: Entity_Id
) is
2510 -- Do not set alignment for packed array types, unless we are doing
2511 -- front end layout, because otherwise this is always handled in the
2514 if Is_Packed_Array_Type
(E
) and then not Frontend_Layout_On_Target
then
2517 -- If there is an alignment clause, then we respect it
2519 elsif Has_Alignment_Clause
(E
) then
2522 -- If the size is not set, then don't attempt to set the alignment. This
2523 -- happens in the backend layout case for access to subprogram types.
2525 elsif not Known_Static_Esize
(E
) then
2528 -- For access types, do not set the alignment if the size is less than
2529 -- the allowed minimum size. This avoids cascaded error messages.
2531 elsif Is_Access_Type
(E
)
2532 and then Esize
(E
) < System_Address_Size
2537 -- Here we calculate the alignment as the largest power of two
2538 -- multiple of System.Storage_Unit that does not exceed either
2539 -- the actual size of the type, or the maximum allowed alignment.
2543 UI_To_Int
(Esize
(E
)) / SSU
;
2548 while 2 * A
<= Ttypes
.Maximum_Alignment
2554 -- Now we think we should set the alignment to A, but we
2555 -- skip this if an alignment is already set to a value
2556 -- greater than A (happens for derived types).
2558 -- However, if the alignment is known and too small it
2559 -- must be increased, this happens in a case like:
2561 -- type R is new Character;
2562 -- for R'Size use 16;
2564 -- Here the alignment inherited from Character is 1, but
2565 -- it must be increased to 2 to reflect the increased size.
2567 if Unknown_Alignment
(E
) or else Alignment
(E
) < A
then
2568 Init_Alignment
(E
, A
);
2571 end Set_Prim_Alignment
;
2573 ----------------------
2574 -- SO_Ref_From_Expr --
2575 ----------------------
2577 function SO_Ref_From_Expr
2579 Ins_Type
: Entity_Id
;
2580 Vtype
: Entity_Id
:= Empty
)
2581 return Dynamic_SO_Ref
2583 Loc
: constant Source_Ptr
:= Sloc
(Ins_Type
);
2585 K
: constant Entity_Id
:=
2586 Make_Defining_Identifier
(Loc
,
2587 Chars
=> New_Internal_Name
('K'));
2591 function Check_Node_V_Ref
(N
: Node_Id
) return Traverse_Result
;
2592 -- Function used to check one node for reference to V
2594 function Has_V_Ref
is new Traverse_Func
(Check_Node_V_Ref
);
2595 -- Function used to traverse tree to check for reference to V
2597 ----------------------
2598 -- Check_Node_V_Ref --
2599 ----------------------
2601 function Check_Node_V_Ref
(N
: Node_Id
) return Traverse_Result
is
2603 if Nkind
(N
) = N_Identifier
then
2604 if Chars
(N
) = Vname
then
2613 end Check_Node_V_Ref
;
2615 -- Start of processing for SO_Ref_From_Expr
2618 -- Case of expression is an integer literal, in this case we just
2619 -- return the value (which must always be non-negative, since size
2620 -- and offset values can never be negative).
2622 if Nkind
(Expr
) = N_Integer_Literal
then
2623 pragma Assert
(Intval
(Expr
) >= 0);
2624 return Intval
(Expr
);
2627 -- Case where there is a reference to V, create function
2629 if Has_V_Ref
(Expr
) = Abandon
then
2631 pragma Assert
(Present
(Vtype
));
2632 Set_Is_Discrim_SO_Function
(K
);
2635 Make_Subprogram_Body
(Loc
,
2638 Make_Function_Specification
(Loc
,
2639 Defining_Unit_Name
=> K
,
2640 Parameter_Specifications
=> New_List
(
2641 Make_Parameter_Specification
(Loc
,
2642 Defining_Identifier
=>
2643 Make_Defining_Identifier
(Loc
, Chars
=> Vname
),
2645 New_Occurrence_Of
(Vtype
, Loc
))),
2647 New_Occurrence_Of
(Standard_Unsigned
, Loc
)),
2649 Declarations
=> Empty_List
,
2651 Handled_Statement_Sequence
=>
2652 Make_Handled_Sequence_Of_Statements
(Loc
,
2653 Statements
=> New_List
(
2654 Make_Return_Statement
(Loc
,
2655 Expression
=> Expr
))));
2657 -- No reference to V, create constant
2661 Make_Object_Declaration
(Loc
,
2662 Defining_Identifier
=> K
,
2663 Object_Definition
=>
2664 New_Occurrence_Of
(Standard_Unsigned
, Loc
),
2665 Constant_Present
=> True,
2666 Expression
=> Expr
);
2669 Append_Freeze_Action
(Ins_Type
, Decl
);
2671 return Create_Dynamic_SO_Ref
(K
);
2672 end SO_Ref_From_Expr
;