| blob | b0e1565758b7d0449dade9f62f744ff0e2b94489 |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- F R E E Z E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
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. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
66 -----------------------
67 -- Local Subprograms --
68 -----------------------
71 -- Typ is a type that is being frozen. If no size clause is given,
72 -- but a default Esize has been computed, then this default Esize is
73 -- adjusted up if necessary to be consistent with a given alignment,
74 -- but never to a value greater than Long_Long_Integer'Size. This
75 -- is used for all discrete types and for fixed-point types.
77 procedure Build_And_Analyze_Renamed_Body
81 -- Build body for a renaming declaration, insert in tree and analyze.
84 -- Apply legality checks to address clauses for object declarations,
85 -- at the point the object is frozen.
88 -- E is a base type. If E is tagged or has a component that is aliased
89 -- or tagged or contains something this is aliased or tagged, set
90 -- Strict_Alignment.
94 -- If E is a fixed-point or discrete type, then all the necessary work
95 -- to freeze it is completed except for possible setting of the flag
96 -- Is_Unsigned_Type, which is done by this procedure. The call has no
97 -- effect if the entity E is not a discrete or fixed-point type.
99 procedure Freeze_And_Append
103 -- Freezes Ent using Freeze_Entity, and appends the resulting list of
104 -- nodes to Result, modifying Result from No_List if necessary.
107 -- Freeze enumeration type. The Esize field is set as processing
108 -- proceeds (i.e. set by default when the type is declared and then
109 -- adjusted by rep clauses. What this procedure does is to make sure
110 -- that if a foreign convention is specified, and no specific size
111 -- is given, then the size must be at least Integer'Size.
114 -- If an object is frozen which has Is_Statically_Allocated set, then
115 -- all referenced types must also be marked with this flag. This routine
116 -- is in charge of meeting this requirement for the object entity E.
119 -- Perform freezing actions for a subprogram (create extra formals,
120 -- and set proper default mechanism values). Note that this routine
121 -- is not called for internal subprograms, for which neither of these
122 -- actions is needed (or desirable, we do not want for example to have
123 -- these extra formals present in initialization procedures, where they
124 -- would serve no purpose). In this call E is either a subprogram or
125 -- a subprogram type (i.e. an access to a subprogram).
128 -- True if T is not private and has no private components, or has a full
129 -- view. Used to determine whether the designated type of an access type
130 -- should be frozen when the access type is frozen. This is done when an
131 -- allocator is frozen, or an expression that may involve attributes of
132 -- the designated type. Otherwise freezing the access type does not freeze
133 -- the designated type.
135 procedure Process_Default_Expressions
138 -- This procedure is called for each subprogram to complete processing
139 -- of default expressions at the point where all types are known to be
140 -- frozen. The expressions must be analyzed in full, to make sure that
141 -- all error processing is done (they have only been pre-analyzed). If
142 -- the expression is not an entity or literal, its analysis may generate
143 -- code which must not be executed. In that case we build a function
144 -- body to hold that code. This wrapper function serves no other purpose
145 -- (it used to be called to evaluate the default, but now the default is
146 -- inlined at each point of call).
149 -- Typ is a record or array type that is being frozen. This routine
150 -- sets the default component alignment from the scope stack values
151 -- if the alignment is otherwise not specified.
154 -- As each entity is frozen, this routine is called to deal with the
155 -- setting of Debug_Info_Needed for the entity. This flag is set if
156 -- the entity comes from source, or if we are in Debug_Generated_Code
157 -- mode or if the -gnatdV debug flag is set. However, it never sets
158 -- the flag if Debug_Info_Off is set.
161 -- Sets the Debug_Info_Needed flag on entity T if not already set, and
162 -- also on any entities that are needed by T (for an object, the type
163 -- of the object is needed, and for a type, the subsidiary types are
164 -- needed -- see body for details). Never has any effect on T if the
165 -- Debug_Info_Off flag is set.
168 -- T is a type of a component that we know to be an Itype.
169 -- We don't want this to have a Freeze_Node, so ensure it doesn't.
170 -- Do the same for any Full_View or Corresponding_Record_Type.
172 procedure Warn_Overlay
176 -- Expr is the expression for an address clause for entity Nam whose type
177 -- is Typ. If Typ has a default initialization, and there is no explicit
178 -- initialization in the source declaration, check whether the address
179 -- clause might cause overlaying of an entity, and emit a warning on the
180 -- side effect that the initialization will cause.
182 -------------------------------
183 -- Adjust_Esize_For_Alignment --
184 -------------------------------
189 begin
195 then
201 ------------------------------------
202 -- Build_And_Analyze_Renamed_Body --
203 ------------------------------------
205 procedure Build_And_Analyze_Renamed_Body
209 is
212 begin
219 ------------------------
220 -- Build_Renamed_Body --
221 ------------------------
223 function Build_Renamed_Body
226 is
228 -- We use for the source location of the renamed body, the location
229 -- of the spec entity. It might seem more natural to use the location
230 -- of the renaming declaration itself, but that would be wrong, since
231 -- then the body we create would look as though it was created far
232 -- too late, and this could cause problems with elaboration order
233 -- analysis, particularly in connection with instantiations.
247 begin
248 -- Determine the entity being renamed, which is the target of the
249 -- call statement. If the name is an explicit dereference, this is
250 -- a renaming of a subprogram type rather than a subprogram. The
251 -- name itself is fully analyzed.
262 else
269 else
275 -- If the renamed entity is a predefined operator, retain full
276 -- name to ensure its visibility.
280 then
282 else
286 else
289 -- The original name may have been overloaded, but
290 -- is fully resolved now.
295 -- For simple renamings, subsequent calls can be expanded directly
296 -- as called to the renamed entity. The body must be generated in
297 -- any case for calls they may appear elsewhere.
302 then
306 -- The body generated for this renaming is an internal artifact, and
307 -- does not constitute a freeze point for the called entity.
322 -- If the renamed entity is an entry, inherit its profile. For
323 -- other renamings as bodies, both profiles must be subtype
324 -- conformant, so it is not necessary to replace the profile given
325 -- in the declaration. However, default values that are aggregates
326 -- are rewritten when partially analyzed, so we recover the original
327 -- aggregate to insure that subsequent conformity checking works.
328 -- Similarly, if the default expression was constant-folded, recover
329 -- the original expression.
341 N_Access_Definition
342 then
350 then
361 -- If the renamed entity is a function, the generated body contains a
362 -- return statement. Otherwise, build a procedure call. If the entity is
363 -- an entry, subsequent analysis of the call will transform it into the
364 -- proper entry or protected operation call. If the renamed entity is
365 -- a character literal, return it directly.
371 then
372 Call_Node :=
374 Expression =>
380 Call_Node :=
385 Call_Node :=
389 else
390 Call_Node :=
396 -- Create entities for subprogram body and formals.
410 Body_Node :=
414 Handled_Statement_Sequence =>
424 -- Link the body to the entity whose declaration it completes. If
425 -- the body is analyzed when the renamed entity is frozen, it may be
426 -- necessary to restore the proper scope (see package Exp_Ch13).
430 then
432 else
439 --------------------------
440 -- Check_Address_Clause --
441 --------------------------
449 begin
453 -- If we have no initialization of any kind, then we don't
454 -- need to place any restrictions on the address clause, because
455 -- the object will be elaborated after the address clause is
456 -- evaluated. This happens if the declaration has no initial
457 -- expression, or the type has no implicit initialization, or
458 -- the object is imported.
460 -- The same holds for all initialized scalar types and all
461 -- access types. Packed bit arrays of size up to 64 are
462 -- represented using a modular type with an initialization
463 -- (to zero) and can be processed like other initialized
464 -- scalar types.
466 -- If the type is controlled, code to attach the object to a
467 -- finalization chain is generated at the point of declaration,
468 -- and therefore the elaboration of the object cannot be delayed:
469 -- the address expression must be a constant.
473 and then
477 or else
481 or else
484 or else
486 and then
488 then
491 -- Otherwise, we require the address clause to be constant
492 -- because the call to the initialization procedure (or the
493 -- attach code) has to happen at the point of the declaration.
495 else
502 then
508 -----------------------------
509 -- Check_Compile_Time_Size --
510 -----------------------------
515 -- Sets the compile time known size (32 bits or less) in the Esize
516 -- field, of T checking for a size clause that was given which attempts
517 -- to give a smaller size.
520 -- Recursive function that does all the work
523 -- If T is a constrained subtype, its size is not known if any of its
524 -- discriminant constraints is not static and it is not a null record.
525 -- The test is conservative and doesn't check that the components are
526 -- in fact constrained by non-static discriminant values. Could be made
527 -- more precise ???
529 --------------------
530 -- Set_Small_Size --
531 --------------------
534 begin
541 Error_Msg_NE
549 -- Set sizes if not set already
551 else
562 ----------------
563 -- Size_Known --
564 ----------------
573 begin
579 then
591 -- Don't do any recursion on type with error posted, since
592 -- we may have a malformed type that leads us into a loop
601 -- Check for all indexes static, and also compute possible
602 -- size (in case it is less than 32 and may be packable).
604 declare
608 begin
617 else
625 then
628 else
633 else
651 then
652 -- Don't do any recursion on type with error posted, since
653 -- we may have a malformed type that leads us into a loop
657 else
663 -- A class-wide type is never considered to have a known size
668 -- A subtype of a variant record must not have non-static
669 -- discriminanted components.
673 then
676 -- Don't do any recursion on type with error posted, since
677 -- we may have a malformed type that leads us into a loop
683 -- Now look at the components of the record
685 declare
686 -- The following two variables are used to keep track of
687 -- the size of packed records if we can tell the size of
688 -- the packed record in the front end. Packed_Size_Known
689 -- is True if so far we can figure out the size. It is
690 -- initialized to True for a packed record, unless the
691 -- record has discriminants. The reason we eliminate the
692 -- discriminated case is that we don't know the way the
693 -- back end lays out discriminated packed records. If
694 -- Packed_Size_Known is True, then Packed_Size is the
695 -- size in bits so far.
703 begin
704 -- Test for variant part present
710 N_Record_Definition
714 then
715 -- If variant part is present, and type is unconstrained,
716 -- then we must have defaulted discriminants, or a size
717 -- clause must be present for the type, or else the size
718 -- is definitely not known at compile time.
721 and then
722 No (Discriminant_Default_Value
725 then
730 -- Loop through components
735 or else
737 then
740 -- We do not know the packed size if there is a
741 -- component clause present (we possibly could,
742 -- but this would only help in the case of a record
743 -- with partial rep clauses. That's because in the
744 -- case of full rep clauses, the size gets figured
745 -- out anyway by a different circuit).
751 -- We need to identify a component that is an array
752 -- where the index type is an enumeration type with
753 -- non-standard representation, and some bound of the
754 -- type depends on a discriminant.
756 -- This is because gigi computes the size by doing a
757 -- substituation of the appropriate discriminant value
758 -- in the size expression for the base type, and gigi
759 -- is not clever enough to evaluate the resulting
760 -- expression (which involves a call to rep_to_pos)
761 -- at compile time.
763 -- It would be nice if gigi would either recognize that
764 -- this expression can be computed at compile time, or
765 -- alternatively figured out the size from the subtype
766 -- directly, where all the information is at hand ???
770 then
771 declare
779 begin
786 then
791 and then
793 then
797 and then
799 then
809 -- Clearly size of record is not known if the size of
810 -- one of the components is not known.
816 -- Accumulate packed size if possible
820 -- We can only deal with elementary types, since for
821 -- non-elementary components, alignment enters into
822 -- the picture, and we don't know enough to handle
823 -- proper alignment in this context. Packed arrays
824 -- count as elementary if the representation is a
825 -- modular type.
829 and then
831 and then
832 Is_Modular_Integer_Type
834 then
835 -- If RM_Size is known and static, then we can
836 -- keep accumulating the packed size.
840 -- A little glitch, to be removed sometime ???
841 -- gigi does not understand zero sizes yet.
846 -- Normal case where we can keep accumulating
847 -- the packed array size.
849 else
853 -- If we have a field whose RM_Size is not known
854 -- then we can't figure out the packed size here.
856 else
860 -- If we have a non-elementary type we can't figure
861 -- out the packed array size (alignment issues).
863 else
879 else
884 -------------------------------------
885 -- Static_Discriminated_Components --
886 -------------------------------------
888 function Static_Discriminated_Components
890 is
893 begin
897 then
911 -- Start of processing for Check_Compile_Time_Size
913 begin
917 -----------------------------
918 -- Check_Debug_Info_Needed --
919 -----------------------------
922 begin
927 or else Debug_Generated_Code
928 or else Debug_Flag_VV
929 then
934 ----------------------------
935 -- Check_Strict_Alignment --
936 ----------------------------
941 begin
960 then
970 -------------------------
971 -- Check_Unsigned_Type --
972 -------------------------
979 begin
984 -- Do not attempt to analyze case where range was in error
990 -- The situation that is non trivial is something like
992 -- subtype x1 is integer range -10 .. +10;
993 -- subtype x2 is x1 range 0 .. V1;
994 -- subtype x3 is x2 range V2 .. V3;
995 -- subtype x4 is x3 range V4 .. V5;
997 -- where Vn are variables. Here the base type is signed, but we still
998 -- know that x4 is unsigned because of the lower bound of x2.
1000 -- The only way to deal with this is to look up the ancestor chain
1003 loop
1018 else
1021 -- If no ancestor had a static lower bound, go to base type
1025 -- Note: the reason we still check for a compile time known
1026 -- value for the base type is that at least in the case of
1027 -- generic formals, we can have bounds that fail this test,
1028 -- and there may be other cases in error situations.
1040 then
1050 -----------------------------
1051 -- Expand_Atomic_Aggregate --
1052 -----------------------------
1059 begin
1064 then
1065 Temp :=
1069 New_N :=
1079 -- To prevent the temporary from being constant-folded (which
1080 -- would lead to the same piecemeal assignment on the original
1081 -- target) indicate to the back-end that the temporary is a
1082 -- variable with real storage. See description of this flag
1083 -- in Einfo, and the notes on N_Assignment_Statement and
1084 -- N_Object_Declaration in Sinfo.
1090 ----------------
1091 -- Freeze_All --
1092 ----------------
1094 -- Note: the easy coding for this procedure would be to just build a
1095 -- single list of freeze nodes and then insert them and analyze them
1096 -- all at once. This won't work, because the analysis of earlier freeze
1097 -- nodes may recursively freeze types which would otherwise appear later
1098 -- on in the freeze list. So we must analyze and expand the freeze nodes
1099 -- as they are generated.
1107 -- This is the internal recursive routine that does freezing of
1108 -- entities (but NOT the analysis of default expressions, which
1109 -- should not be recursive, we don't want to analyze those till
1110 -- we are sure that ALL the types are frozen).
1112 --------------------
1113 -- Freeze_All_Ent --
1114 --------------------
1116 procedure Freeze_All_Ent
1119 is
1125 -- If freeze nodes are present, insert and analyze, and reset
1126 -- cursor for next insertion.
1128 -------------------
1129 -- Process_Flist --
1130 -------------------
1133 begin
1140 else
1146 -- Start or processing for Freeze_All_Ent
1148 begin
1152 -- If the entity is an inner package which is not a package
1153 -- renaming, then its entities must be frozen at this point.
1154 -- Note that such entities do NOT get frozen at the end of
1155 -- the nested package itself (only library packages freeze).
1157 -- Same is true for task declarations, where anonymous records
1158 -- created for entry parameters must be frozen.
1164 then
1174 and then
1176 or else
1178 then
1181 End_Scope;
1183 -- For a derived tagged type, we must ensure that all the
1184 -- primitive operations of the parent have been frozen, so
1185 -- that their addresses will be in the parent's dispatch table
1186 -- at the point it is inherited.
1192 then
1193 declare
1200 begin
1208 then
1210 Process_Flist;
1220 Process_Flist;
1223 -- If an incomplete type is still not frozen, this may be
1224 -- a premature freezing because of a body declaration that
1225 -- follows. Indicate where the freezing took place.
1227 -- If the freezing is caused by the end of the current
1228 -- declarative part, it is a Taft Amendment type, and there
1229 -- is no error.
1233 then
1234 declare
1237 begin
1244 and then
1246 then
1248 Error_Msg_NE
1259 -- Start of processing for Freeze_All
1261 begin
1264 -- Now that all types are frozen, we can deal with default expressions
1265 -- that require us to build a default expression functions. This is the
1266 -- point at which such functions are constructed (after all types that
1267 -- might be used in such expressions have been frozen).
1269 -- We also add finalization chains to access types whose designated
1270 -- types are controlled. This is normally done when freezing the type,
1271 -- but this misses recursive type definitions where the later members
1272 -- of the recursion introduce controlled components (e.g. 5624-001).
1274 -- Loop through entities
1292 and then
1294 = N_Subprogram_Renaming_Declaration
1295 then
1296 Build_And_Analyze_Renamed_Body
1302 and then
1304 or else
1306 then
1307 declare
1309 begin
1316 then
1329 then
1337 -----------------------
1338 -- Freeze_And_Append --
1339 -----------------------
1341 procedure Freeze_And_Append
1345 is
1347 begin
1351 else
1357 -------------------
1358 -- Freeze_Before --
1359 -------------------
1363 begin
1369 -------------------
1370 -- Freeze_Entity --
1371 -------------------
1383 -- Check that an Access or Unchecked_Access attribute with
1384 -- a prefix which is the current instance type can only be
1385 -- applied when the type is limited.
1388 -- If Loc is a freeze_entity that appears after the last declaration
1389 -- in the scope, inhibit error messages on late completion.
1392 -- Freeze each component, handle some representation clauses, and
1393 -- freeze primitive operations if this is a tagged type.
1395 ----------------------------
1396 -- After_Last_Declaration --
1397 ----------------------------
1402 begin
1409 else
1413 else
1418 ----------------------------
1419 -- Check_Current_Instance --
1420 ----------------------------
1425 -- Process routine to apply check to given node.
1427 -------------
1428 -- Process --
1429 -------------
1432 begin
1436 or else
1441 then
1442 Error_Msg_N
1445 else
1455 -- Start of processing for Check_Current_Instance
1457 begin
1461 ------------------------
1462 -- Freeze_Record_Type --
1463 ------------------------
1473 -- Set True if we find at least one component with no component
1474 -- clause (used to warn about useless Pack pragmas).
1477 -- Set True if we find at least one component with a component
1478 -- clause (used to warn about useless Bit_Order pragmas).
1481 -- If the component subtype is an access to a constrained subtype
1482 -- of an already frozen type, make the subtype frozen as well. It
1483 -- might otherwise be frozen in the wrong scope, and a freeze node
1484 -- on subtype has no effect.
1486 -----------------
1487 -- Check_Itype --
1488 -----------------
1491 begin
1494 then
1497 -- In addition, add an Itype_Reference to ensure that the
1498 -- access subtype is elaborated early enough. This cannot
1499 -- be done if the subtype may depend on discriminants.
1504 then
1510 else
1517 -- Start of processing for Freeze_Record_Type
1519 begin
1520 -- If this is a subtype of a controlled type, declared without
1521 -- a constraint, the _controller may not appear in the component
1522 -- list if the parent was not frozen at the point of subtype
1523 -- declaration. Inherit the _controller component now.
1527 then
1530 then
1533 -- If this is an internal type without a declaration, as for a
1534 -- record component, the base type may not yet be frozen, and its
1535 -- controller has not been created. Add an explicit freeze node
1536 -- for the itype, so it will be frozen after the base type.
1540 and then
1542 N_Component_Declaration
1543 then
1548 -- Freeze components and embedded subtypes.
1555 -- First handle the (real) component case.
1559 then
1560 declare
1563 begin
1564 -- Freezing a record type freezes the type of each of its
1565 -- components. However, if the type of the component is
1566 -- part of this record, we do not want or need a separate
1567 -- Freeze_Node. Note that Is_Itype is wrong because that's
1568 -- also set in private type cases. We also can't check
1569 -- for the Scope being exactly Rec because of private types
1570 -- and record extensions.
1574 then
1580 -- Check for error of component clause given for variable
1581 -- sized type. We have to delay this test till this point,
1582 -- since the component type has to be frozen for us to know
1583 -- if it is variable length. We omit this test in a generic
1584 -- context, it will be applied at instantiation time.
1592 elsif not Size_Known_At_Compile_Time
1594 then
1595 Error_Msg_N
1600 else
1604 -- Case of component requires byte alignment
1608 -- Set the enclosing record to also require byte align
1612 -- Check for component clause that is inconsistent
1613 -- with the required byte boundary alignment.
1618 then
1619 Error_Msg_N
1625 -- If component clause is present, then deal with the
1626 -- non-default bit order case. We cannot do this before
1627 -- the freeze point, because there is no required order
1628 -- for the component clause and the bit_order clause.
1630 -- We only do this processing for the base type, and in
1631 -- fact that's important, since otherwise if there are
1632 -- record subtypes, we could reverse the bits once for
1633 -- each subtype, which would be incorrect.
1638 then
1639 declare
1652 begin
1653 -- Cases where field goes over storage unit boundary
1657 -- Allow multi-byte field but generate warning
1661 then
1662 Error_Msg_N
1667 Error_Msg_N
1670 else
1671 Error_Msg_N
1676 -- Do not allow non-contiguous field
1678 else
1679 Error_Msg_N
1682 Error_Msg_N
1687 -- Case where field fits in one storage unit
1689 else
1690 -- Give warning if suspicious component clause
1693 Error_Msg_N
1696 Error_Msg_Uint_1 :=
1698 System_Storage_Unit;
1699 Error_Msg_N
1704 -- Here is where we fix up the Component_Bit_Offset
1705 -- value to account for the reverse bit order.
1706 -- Some examples of what needs to be done are:
1708 -- First_Bit .. Last_Bit Component_Bit_Offset
1709 -- old new old new
1711 -- 0 .. 0 7 .. 7 0 7
1712 -- 0 .. 1 6 .. 7 0 6
1713 -- 0 .. 2 5 .. 7 0 5
1714 -- 0 .. 7 0 .. 7 0 4
1716 -- 1 .. 1 6 .. 6 1 6
1717 -- 1 .. 4 3 .. 6 1 3
1718 -- 4 .. 7 0 .. 3 4 0
1720 -- The general rule is that the first bit is
1721 -- is obtained by subtracting the old ending bit
1722 -- from storage_unit - 1.
1724 Set_Component_Bit_Offset
1730 Set_Normalized_First_Bit
1733 System_Storage_Unit);
1740 -- If the component is an Itype with Delayed_Freeze and is
1741 -- either a record or array subtype and its base type has not
1742 -- yet been frozen, we must remove this from the entity list
1743 -- of this record and put it on the entity list of the scope of
1744 -- its base type. Note that we know that this is not the type
1745 -- of a component since we cleared Has_Delayed_Freeze for it
1746 -- in the previous loop. Thus this must be the Designated_Type
1747 -- of an access type, which is the type of a component.
1754 then
1755 declare
1759 begin
1760 -- We have a pretty bad kludge here. Suppose Rec is a
1761 -- subtype being defined in a subprogram that's created
1762 -- as part of the freezing of Rec'Base. In that case,
1763 -- we know that Comp'Base must have already been frozen by
1764 -- the time we get to elaborate this because Gigi doesn't
1765 -- elaborate any bodies until it has elaborated all of the
1766 -- declarative part. But Is_Frozen will not be set at this
1767 -- point because we are processing code in lexical order.
1769 -- We detect this case by going up the Scope chain of
1770 -- Rec and seeing if we have a subprogram scope before
1771 -- reaching the top of the scope chain or that of Comp'Base.
1772 -- If we do, then mark that Comp'Base will actually be
1773 -- frozen. If so, we merely undelay it.
1787 else
1790 else
1794 -- Insert in entity list of scope of base type (which
1795 -- must be an enclosing scope, because still unfrozen).
1801 -- If the component is an access type with an allocator
1802 -- as default value, the designated type will be frozen
1803 -- by the corresponding expression in init_proc. In order
1804 -- to place the freeze node for the designated type before
1805 -- that for the current record type, freeze it now.
1807 -- Same process if the component is an array of access types,
1808 -- initialized with an aggregate. If the designated type is
1809 -- private, it cannot contain allocators, and it is premature
1810 -- to freeze the type, so we check for this as well.
1816 then
1817 declare
1820 begin
1821 -- If component is pointer to a classwide type, freeze
1822 -- the specific type in the expression being allocated.
1823 -- The expression may be a subtype indication, in which
1824 -- case freeze the subtype mark.
1828 Freeze_And_Append
1830 elsif
1832 then
1833 Freeze_And_Append
1841 else
1842 Freeze_And_Append
1849 then
1858 and then Is_Fully_Defined
1860 then
1861 Freeze_And_Append
1862 (Designated_Type
1870 -- Check for useless pragma Bit_Order
1878 -- Check for useless pragma Pack when all components placed
1881 and then not Unplaced_Component
1882 and then Warn_On_Redundant_Constructs
1883 then
1884 Error_Msg_N
1890 -- If this is the record corresponding to a remote type,
1891 -- freeze the remote type here since that is what we are
1892 -- semantically freezing. This prevents having the freeze
1893 -- node for that type in an inner scope.
1895 -- Also, Check for controlled components and unchecked unions.
1896 -- Finally, enforce the restriction that access attributes with
1897 -- a current instance prefix can only apply to limited types.
1901 Freeze_And_Append
1911 and then Present
1913 and then Has_Controlled_Component
1915 then
1926 then
1927 -- Scan component declaration for likely misuses of
1928 -- current instance, either in a constraint or in a
1929 -- default expression.
1940 -- For first subtypes, check if there are any fixed-point
1941 -- fields with component clauses, where we must check the size.
1942 -- This is not done till the freeze point, since for fixed-point
1943 -- types, we do not know the size until the type is frozen.
1944 -- Similar processing applies to bit packed arrays.
1952 or else
1954 then
1955 Check_Size
1959 Junk);
1967 -- Start of processing for Freeze_Entity
1969 begin
1970 -- We are going to test for various reasons why this entity need
1971 -- not be frozen here, but in the case of an Itype that's defined
1972 -- within a record, that test actually applies to the record.
1977 then
1981 -- Do not freeze if already frozen since we only need one freeze node
1986 -- It is improper to freeze an external entity within a generic
1987 -- because its freeze node will appear in a non-valid context.
1988 -- The entity will be frozen in the proper scope after the current
1989 -- generic is analyzed.
1994 -- Do not freeze a global entity within an inner scope created during
1995 -- expansion. A call to subprogram E within some internal procedure
1996 -- (a stream attribute for example) might require freezing E, but the
1997 -- freeze node must appear in the same declarative part as E itself.
1998 -- The two-pass elaboration mechanism in gigi guarantees that E will
1999 -- be frozen before the inner call is elaborated. We exclude constants
2000 -- from this test, because deferred constants may be frozen early, and
2001 -- must be diagnosed (see e.g. 1522-005). If the enclosing subprogram
2002 -- comes from source, or is a generic instance, then the freeze point
2003 -- is the one mandated by the language. and we freze the entity.
2008 then
2009 declare
2012 begin
2017 then
2019 else
2028 -- Similarly, an inlined instance body may make reference to global
2029 -- entities, but these references cannot be the proper freezing point
2030 -- for them, and the the absence of inlining freezing will take place
2031 -- in their own scope. Normally instance bodies are analyzed after
2032 -- the enclosing compilation, and everything has been frozen at the
2033 -- proper place, but with front-end inlining an instance body is
2034 -- compiled before the end of the enclosing scope, and as a result
2035 -- out-of-order freezing must be prevented.
2037 elsif Front_End_Inlining
2038 and then In_Instance_Body
2040 then
2041 declare
2043 begin
2047 else
2058 -- Here to freeze the entity
2063 -- Case of entity being frozen is other than a type
2067 -- If entity is exported or imported and does not have an external
2068 -- name, now is the time to provide the appropriate default name.
2069 -- Skip this if the entity is stubbed, since we don't need a name
2070 -- for any stubbed routine.
2075 then
2076 Set_Encoded_Interface_Name
2079 -- Special processing for atomic objects appearing in object decls
2084 then
2085 declare
2088 begin
2089 -- If expression is an aggregate, assign to a temporary to
2090 -- ensure that the actual assignment is done atomically rather
2091 -- than component-wise (the assignment to the temp may be done
2092 -- component-wise, but that is harmless.
2097 -- If the expression is a reference to a record or array
2098 -- object entity, then reset Is_True_Constant to False so
2099 -- that the compiler will not optimize away the intermediate
2100 -- object, which we need in this case for the same reason
2101 -- (to ensure that the actual assignment is atomic, rather
2102 -- than component-wise).
2106 or else
2108 then
2114 -- For a subprogram, freeze all parameter types and also the return
2115 -- type (RM 13.14(14)). However skip this for internal subprograms.
2116 -- This is also the point where any extra formal parameters are
2117 -- created since we now know whether the subprogram will use
2118 -- a foreign convention.
2122 declare
2127 -- Determines if given type entity is a fat pointer type
2128 -- used as an argument type or return type to a subprogram
2129 -- with C or C++ convention set.
2131 --------------------------
2132 -- Is_Fat_C_Access_Type --
2133 --------------------------
2136 begin
2138 or else
2144 begin
2145 -- Loop through formals
2157 then
2158 -- If the type of a formal is incomplete, subprogram
2159 -- is being frozen prematurely. Within an instance
2160 -- (but not within a wrapper package) this is an
2161 -- an artifact of our need to regard the end of an
2162 -- instantiation as a freeze point. Otherwise it is
2163 -- a definite error.
2165 -- and then not Is_Wrapper_Package (Current_Scope) ???
2173 Error_Msg
2175 Loc);
2179 -- Check bad use of fat C pointer
2183 then
2185 Error_Msg_N
2187 Formal);
2191 -- Check for unconstrained array in exported foreign
2192 -- convention case.
2198 and then Warn_On_Export_Import
2199 then
2202 -- If this is an inherited operation, place the
2203 -- warning on the derived type declaration, rather
2204 -- than on the original subprogram.
2207 N_Full_Type_Declaration
2208 then
2212 Error_Msg_NE
2215 else
2219 Error_Msg_NE
2222 Error_Msg_NE
2231 -- Check return type
2236 if Warn_On_Export_Import
2238 then
2239 Error_Msg_N
2241 E);
2247 and then Warn_On_Export_Import
2248 then
2249 Error_Msg_N
2257 -- Must freeze its parent first if it is a derived subprogram
2263 -- If the return type requires a transient scope, and we are on
2264 -- a target allowing functions to return with a depressed stack
2265 -- pointer, then we mark the function as requiring this treatment.
2268 and then Functions_Return_By_DSP_On_Target
2270 then
2278 -- Here for other than a subprogram or type
2280 else
2281 -- If entity has a type, and it is not a generic unit, then
2282 -- freeze it first (RM 13.14(10))
2286 then
2290 -- Special processing for objects created by object declaration
2294 -- For object created by object declaration, perform required
2295 -- categorization (preelaborate and pure) checks. Defer these
2296 -- checks to freeze time since pragma Import inhibits default
2297 -- initialization and thus pragma Import affects these checks.
2301 -- If there is an address clause, check it is valid
2305 -- For imported objects, set Is_Public unless there is also
2306 -- an address clause, which means that there is no external
2307 -- symbol needed for the Import (Is_Public may still be set
2308 -- for other unrelated reasons). Note that we delayed this
2309 -- processing till freeze time so that we can be sure not
2310 -- to set the flag if there is an address clause. If there
2311 -- is such a clause, then the only purpose of the import
2312 -- pragma is to suppress implicit initialization.
2316 then
2321 -- Check that a constant which has a pragma Volatile[_Components]
2322 -- or Atomic[_Components] also has a pragma Import (RM C.6(13))
2324 -- Note: Atomic[_Components] also sets Volatile[_Components]
2329 then
2330 -- Make sure we actually have a pragma, and have not merely
2331 -- inherited the indication from elsewhere (e.g. an address
2332 -- clause, which is not good enough in RM terms!)
2335 or else
2337 then
2338 Error_Msg_N
2343 or else
2345 then
2346 Error_Msg_N
2352 -- Static objects require special handling
2356 then
2360 -- Remaining step is to layout objects
2363 or else
2365 or else
2367 or else
2369 then
2374 -- Case of a type or subtype being frozen
2376 else
2377 -- The type may be defined in a generic unit. This can occur when
2378 -- freezing a generic function that returns the type (which is
2379 -- defined in a parent unit). It is clearly meaningless to freeze
2380 -- this type. However, if it is a subtype, its size may be determi-
2381 -- nable and used in subsequent checks, so might as well try to
2382 -- compute it.
2386 then
2391 -- Deal with special cases of freezing for subtype
2395 -- If ancestor subtype present, freeze that first.
2396 -- Note that this will also get the base type frozen.
2403 -- Otherwise freeze the base type of the entity before
2404 -- freezing the entity itself, (RM 13.14(15)).
2410 -- For a derived type, freeze its parent type first (RM 13.14(15))
2417 -- For array type, freeze index types and component type first
2418 -- before freezing the array (RM 13.14(15)).
2421 declare
2426 -- Set true if any of the index types is an enumeration
2427 -- type with a non-standard representation.
2429 begin
2438 then
2445 -- Processing that is done only for base types
2449 -- Propagate flags for component type
2453 then
2461 -- If packing was requested or if the component size was set
2462 -- explicitly, then see if bit packing is required. This
2463 -- processing is only done for base types, since all the
2464 -- representation aspects involved are type-related. This
2465 -- is not just an optimization, if we start processing the
2466 -- subtypes, they intefere with the settings on the base
2467 -- type (this is because Is_Packed has a slightly different
2468 -- meaning before and after freezing).
2470 declare
2474 begin
2478 then
2487 else
2490 -- We can set the component size if it is less than
2491 -- 16, rounding it up to the next storage unit size.
2497 else
2501 -- Set component size up to match alignment if
2502 -- it would otherwise be less than the alignment.
2503 -- This deals with cases of types whose alignment
2504 -- exceeds their sizes (padded types).
2507 declare
2510 begin
2521 -- We set the component size for all cases 1-64
2525 -- Check for base type of 8,16,32 bits, where the
2526 -- subtype has a length one less than the base type
2527 -- and is unsigned (e.g. Natural subtype of Integer)
2529 -- In such cases, if a component size was not set
2530 -- explicitly, then generate a warning.
2534 and then
2537 then
2539 Pnod :=
2543 Error_Msg_N
2545 Pnod);
2546 Error_Msg_N
2548 Pnod);
2552 -- Actual packing is not needed for 8,16,32,64
2553 -- Also not needed for 24 if alignment is 1
2560 then
2561 -- Here the array was requested to be packed, but
2562 -- the packing request had no effect, so Is_Packed
2563 -- is reset.
2565 -- Note: semantically this means that we lose
2566 -- track of the fact that a derived type inherited
2567 -- a pack pragma that was non-effective, but that
2568 -- seems fine.
2570 -- We regard a Pack pragma as a request to set a
2571 -- representation characteristic, and this request
2572 -- may be ignored.
2576 -- In all other cases, packing is indeed needed
2578 else
2586 -- Processing that is done only for subtypes
2588 else
2589 -- Acquire alignment from base type
2596 -- For bit-packed arrays, check the size
2600 then
2601 declare
2605 begin
2606 -- It is not clear if it is possible to have no size
2607 -- clause at this stage, but this is not worth worrying
2608 -- about. Post the error on the entity name in the size
2609 -- clause if present, else on the type entity itself.
2613 else
2619 -- Check one common case of a size given where the array
2620 -- needs to be packed, but was not so the size cannot be
2621 -- honored. This would of course be caught by the backend,
2622 -- and indeed we don't catch all cases. The point is that
2623 -- we can give a better error message in those cases that
2624 -- we do catch with the circuitry here.
2626 declare
2630 begin
2638 then
2645 then
2646 declare
2653 -- What we are looking for here is the situation
2654 -- where the Esize given would be exactly right
2655 -- if there was a pragma Pack (resulting in the
2656 -- component size being the same as the RM_Size).
2657 -- Furthermore, the component type size must be
2658 -- an odd size (not a multiple of storage unit)
2660 begin
2663 then
2664 Error_Msg_NE
2667 Error_Msg_N
2676 -- If any of the index types was an enumeration type with
2677 -- a non-standard rep clause, then we indicate that the
2678 -- array type is always packed (even if it is not bit packed).
2687 -- If the array is packed, we must create the packed array
2688 -- type to be used to actually implement the type. This is
2689 -- only needed for real array types (not for string literal
2690 -- types, since they are present only for the front end).
2694 then
2698 -- Size information of packed array type is copied to the
2699 -- array type, since this is really the representation.
2705 -- For non-packed arrays set the alignment of the array
2706 -- to the alignment of the component type if it is unknown.
2707 -- Skip this in the atomic case, since atomic arrays may
2708 -- need larger alignments.
2717 then
2722 -- For a class-wide type, the corresponding specific type is
2723 -- frozen as well (RM 13.14(15))
2728 -- If the Class_Wide_Type is an Itype (when type is the anonymous
2729 -- parent of a derived type) and it is a library-level entity,
2730 -- generate an itype reference for it. Otherwise, its first
2731 -- explicit reference may be in an inner scope, which will be
2732 -- rejected by the back-end.
2736 then
2737 declare
2740 begin
2744 else
2750 -- The equivalent type associated with a class-wide subtype
2751 -- needs to be frozen to ensure that its layout is done.
2752 -- Class-wide subtypes are currently only frozen on targets
2753 -- requiring front-end layout (see New_Class_Wide_Subtype
2754 -- and Make_CW_Equivalent_Type in exp_util.adb).
2758 then
2762 -- For a record (sub)type, freeze all the component types (RM
2763 -- 13.14(15). We test for E_Record_(sub)Type here, rather than
2764 -- using Is_Record_Type, because we don't want to attempt the
2765 -- freeze for the case of a private type with record extension
2766 -- (we will do that later when the full type is frozen).
2770 then
2773 -- For a concurrent type, freeze corresponding record type. This
2774 -- does not correpond to any specific rule in the RM, but the
2775 -- record type is essentially part of the concurrent type.
2776 -- Freeze as well all local entities. This includes record types
2777 -- created for entry parameter blocks, and whatever local entities
2778 -- may appear in the private part.
2782 Freeze_And_Append
2795 then
2805 -- Private types are required to point to the same freeze node
2806 -- as their corresponding full views. The freeze node itself
2807 -- has to point to the partial view of the entity (because
2808 -- from the partial view, we can retrieve the full view, but
2809 -- not the reverse). However, in order to freeze correctly,
2810 -- we need to freeze the full view. If we are freezing at the
2811 -- end of a scope (or within the scope of the private type),
2812 -- the partial and full views will have been swapped, the
2813 -- full view appears first in the entity chain and the swapping
2814 -- mechanism ensures that the pointers are properly set (on
2815 -- scope exit).
2817 -- If we encounter the partial view before the full view
2818 -- (e.g. when freezing from another scope), we freeze the
2819 -- full view, and then set the pointers appropriately since
2820 -- we cannot rely on swapping to fix things up (subtypes in an
2821 -- outer scope might not get swapped).
2825 then
2826 -- Case of full view present
2830 -- If full view has already been frozen, then no
2831 -- further processing is required
2839 -- Otherwise freeze full view and patch the pointers
2840 -- so that the freeze node will elaborate both views
2841 -- in the back-end.
2843 else
2844 declare
2847 begin
2850 then
2851 Freeze_And_Append
2864 else
2865 -- {Incomplete,Private}_Subtypes
2866 -- with Full_Views constrained by discriminants
2877 -- AI-117 requires that the convention of a partial view
2878 -- be the same as the convention of the full view. Note
2879 -- that this is a recognized breach of privacy, but it's
2880 -- essential for logical consistency of representation,
2881 -- and the lack of a rule in RM95 was an oversight.
2888 -- Size information is copied from the full view to the
2889 -- incomplete or private view for consistency
2891 -- We skip this is the full view is not a type. This is
2892 -- very strange of course, and can only happen as a result
2893 -- of certain illegalities, such as a premature attempt to
2894 -- derive from an incomplete type.
2903 -- Case of no full view present. If entity is derived or subtype,
2904 -- it is safe to freeze, correctness depends on the frozen status
2905 -- of parent. Otherwise it is either premature usage, or a Taft
2906 -- amendment type, so diagnosis is at the point of use and the
2907 -- type might be frozen later.
2911 then
2914 else
2919 -- For access subprogram, freeze types of all formals, the return
2920 -- type was already frozen, since it is the Etype of the function.
2929 -- If the return type requires a transient scope, and we are on
2930 -- a target allowing functions to return with a depressed stack
2931 -- pointer, then we mark the function as requiring this treatment.
2933 if Functions_Return_By_DSP_On_Target
2935 then
2941 -- For access to a protected subprogram, freeze the equivalent
2942 -- type (however this is not set if we are not generating code)
2943 -- or if this is an anonymous type used just for resolution).
2948 then
2952 -- Generic types are never seen by the back-end, and are also not
2953 -- processed by the expander (since the expander is turned off for
2954 -- generic processing), so we never need freeze nodes for them.
2960 -- Some special processing for non-generic types to complete
2961 -- representation details not known till the freeze point.
2966 -- Some error checks required for ordinary fixed-point type.
2967 -- Defer these till the freeze-point since we need the small
2968 -- and range values. We only do these checks for base types
2972 then
2975 Error_Msg_N
2980 Error_Msg_N
2986 Error_Msg_N
2992 Error_Msg_N
3005 then
3011 -- AI-117 requires that all new primitives of a tagged type
3012 -- must inherit the convention of the full view of the type.
3013 -- Inherited and overriding operations are defined to inherit
3014 -- the convention of their parent or overridden subprogram
3015 -- (also specified in AI-117), and that will have occurred
3016 -- earlier (in Derive_Subprogram and New_Overloaded_Entity).
3017 -- Here we set the convention of primitives that are still
3018 -- convention Ada, which will ensure that any new primitives
3019 -- inherit the type's convention. Class-wide types can have
3020 -- a foreign convention inherited from their specific type,
3021 -- but are excluded from this since they don't have any
3022 -- associated primitives.
3027 then
3028 declare
3031 begin
3044 -- Generate primitive operation references for a tagged type
3048 then
3049 declare
3054 begin
3059 -- If the operation is derived, get the original for
3060 -- cross-reference purposes (it is the original for
3061 -- which we want the xref, and for which the comes
3062 -- from source test needs to be performed).
3072 -- If we get an exception, then something peculiar has happened
3073 -- probably as a result of a previous error. Since this is only
3074 -- for non-critical cross-references, ignore the error.
3076 exception
3081 -- Now that all types from which E may depend are frozen, see
3082 -- if the size is known at compile time, if it must be unsigned,
3083 -- or if strict alignent is required
3092 -- Do not allow a size clause for a type which does not have a size
3093 -- that is known at compile time
3097 then
3098 -- Supress this message if errors posted on E, even if we are
3099 -- in all errors mode, since this is often a junk message
3102 Error_Msg_N
3108 -- Remaining process is to set/verify the representation information,
3109 -- in particular the size and alignment values. This processing is
3110 -- not required for generic types, since generic types do not play
3111 -- any part in code generation, and so the size and alignment values
3112 -- for such types are irrelevant.
3117 -- Otherwise we call the layout procedure
3119 else
3123 -- End of freeze processing for type entities
3126 -- Here is where we logically freeze the current entity. If it has a
3127 -- freeze node, then this is the point at which the freeze node is
3128 -- linked into the result list.
3132 -- If a freeze node is already allocated, use it, otherwise allocate
3133 -- a new one. The preallocation happens in the case of anonymous base
3134 -- types, where we preallocate so that we can set First_Subtype_Link.
3135 -- Note that we reset the Sloc to the current freeze location.
3141 else
3153 else
3157 -- A final pass over record types with discriminants. If the type
3158 -- has an incomplete declaration, there may be constrained access
3159 -- subtypes declared elsewhere, which do not depend on the discrimi-
3160 -- nants of the type, and which are used as component types (i.e.
3161 -- the full view is a recursive type). The designated types of these
3162 -- subtypes can only be elaborated after the type itself, and they
3163 -- need an itype reference.
3167 then
3168 declare
3173 begin
3184 then
3196 -- When a type is frozen, the first subtype of the type is frozen as
3197 -- well (RM 13.14(15)). This has to be done after freezing the type,
3198 -- since obviously the first subtype depends on its own base type.
3203 -- If we just froze a tagged non-class wide record, then freeze the
3204 -- corresponding class-wide type. This must be done after the tagged
3205 -- type itself is frozen, because the class-wide type refers to the
3206 -- tagged type which generates the class.
3211 then
3218 -- Special handling for subprograms
3222 -- If subprogram has address clause then reset Is_Public flag, since
3223 -- we do not want the backend to generate external references.
3227 then
3230 -- If no address clause and not intrinsic, then for imported
3231 -- subprogram in main unit, generate descriptor if we are in
3232 -- Propagate_Exceptions mode.
3234 elsif Propagate_Exceptions
3238 then
3243 Generate_Subprogram_Descriptor_For_Imported_Subprogram
3251 -----------------------------
3252 -- Freeze_Enumeration_Type --
3253 -----------------------------
3256 begin
3260 then
3262 else
3267 -----------------------
3268 -- Freeze_Expression --
3269 -----------------------
3280 -- This flag is set true if the entity must be frozen outside the
3281 -- current subprogram. This happens in the case of expander generated
3282 -- subprograms (_Init_Proc, _Input, _Output, _Read, _Write) which do
3283 -- not freeze all entities like other bodies, but which nevertheless
3284 -- may reference entities that have to be frozen before the body and
3285 -- obviously cannot be frozen inside the body.
3288 -- Given an N_Handled_Sequence_Of_Statements node N, determines whether
3289 -- it is the handled statement sequence of an expander generated
3290 -- subprogram (init proc, or stream subprogram). If so, it returns
3291 -- True, otherwise False.
3293 -----------------
3294 -- In_Exp_Body --
3295 -----------------
3300 begin
3303 else
3310 else
3319 then
3321 else
3327 -- Start of processing for Freeze_Expression
3329 begin
3330 -- Immediate return if freezing is inhibited. This flag is set by
3331 -- the analyzer to stop freezing on generated expressions that would
3332 -- cause freezing if they were in the source program, but which are
3333 -- not supposed to freeze, since they are created.
3339 -- If expression is non-static, then it does not freeze in a default
3340 -- expression, see section "Handling of Default Expressions" in the
3341 -- spec of package Sem for further details. Note that we have to
3342 -- make sure that we actually have a real expression (if we have
3343 -- a subtype indication, we can't test Is_Static_Expression!)
3345 if In_Def_Exp
3348 then
3352 -- Freeze type of expression if not frozen already
3360 -- Base type may be an derived numeric type that is frozen at
3361 -- the point of declaration, but first_subtype is still unfrozen.
3368 -- For entity name, freeze entity if not frozen already. A special
3369 -- exception occurs for an identifier that did not come from source.
3370 -- We don't let such identifiers freeze a non-internal entity, i.e.
3371 -- an entity that did come from source, since such an identifier was
3372 -- generated by the expander, and cannot have any semantic effect on
3373 -- the freezing semantics. For example, this stops the parameter of
3374 -- an initialization procedure from freezing the variable.
3381 then
3383 else
3387 -- For an allocator freeze designated type if not frozen already.
3389 -- For an aggregate whose component type is an access type, freeze
3390 -- the designated type now, so that its freeze does not appear within
3391 -- the loop that might be created in the expansion of the aggregate.
3392 -- If the designated type is a private type without full view, the
3393 -- expression cannot contain an allocator, so the type is not frozen.
3404 then
3408 when N_Selected_Component |
3409 N_Indexed_Component |
3410 N_Slice =>
3423 then
3427 -- All done if nothing needs freezing
3432 then
3436 -- Loop for looking at the right place to insert the freeze nodes
3437 -- exiting from the loop when it is appropriate to insert the freeze
3438 -- node before the current node P.
3440 -- Also checks some special exceptions to the freezing rules. These
3441 -- cases result in a direct return, bypassing the freeze action.
3444 loop
3447 -- If we don't have a parent, then we are not in a well-formed
3448 -- tree. This is an unusual case, but there are some legitimate
3449 -- situations in which this occurs, notably when the expressions
3450 -- in the range of a type declaration are resolved. We simply
3451 -- ignore the freeze request in this case. Is this right ???
3457 -- See if we have got to an appropriate point in the tree
3461 -- A special test for the exception of (RM 13.14(8)) for the
3462 -- case of per-object expressions (RM 3.8(18)) occurring in a
3463 -- component definition or a discrete subtype definition. Note
3464 -- that we test for a component declaration which includes both
3465 -- cases we are interested in, and furthermore the tree does not
3466 -- have explicit nodes for either of these two constructs.
3470 -- The case we want to test for here is an identifier that is
3471 -- a per-object expression, this is either a discriminant that
3472 -- appears in a context other than the component declaration
3473 -- or it is a reference to the type of the enclosing construct.
3475 -- For either of these cases, we skip the freezing
3477 if not In_Default_Expression
3480 then
3481 -- We recognize the discriminant case by just looking for
3482 -- a reference to a discriminant. It can only be one for
3483 -- the enclosing construct. Skip freezing in this case.
3488 -- For the case of a reference to the enclosing record,
3489 -- (or task or protected type), we look for a type that
3490 -- matches the current scope.
3497 -- If we have an enumeration literal that appears as the
3498 -- choice in the aggregate of an enumeration representation
3499 -- clause, then freezing does not occur (RM 13.14(10)).
3503 -- The case we are looking for is an enumeration literal
3507 then
3508 -- If enumeration literal appears directly as the choice,
3509 -- do not freeze (this is the normal non-overloade case)
3513 then
3516 -- If enumeration literal appears as the name of a
3517 -- function which is the choice, then also do not freeze.
3518 -- This happens in the overloaded literal case, where the
3519 -- enumeration literal is temporarily changed to a function
3520 -- call for overloading analysis purposes.
3523 and then
3525 and then
3527 then
3532 -- Normally if the parent is a handled sequence of statements,
3533 -- then the current node must be a statement, and that is an
3534 -- appropriate place to insert a freeze node.
3538 -- An exception occurs when the sequence of statements is
3539 -- for an expander generated body that did not do the usual
3540 -- freeze all operation. In this case we usually want to
3541 -- freeze outside this body, not inside it, and we skip
3542 -- past the subprogram body that we are inside.
3546 -- However, we *do* want to freeze at this point if we have
3547 -- an entity to freeze, and that entity is declared *inside*
3548 -- the body of the expander generated procedure. This case
3549 -- is recognized by the scope of the type, which is either
3550 -- the spec for some enclosing body, or (in the case of
3551 -- init_procs, for which there are no separate specs) the
3552 -- current scope.
3554 declare
3558 begin
3563 or else
3565 then
3571 then
3577 -- If not that exception to the exception, then this is
3578 -- where we delay the freeze till outside the body.
3583 -- Here if normal case where we are in handled statement
3584 -- sequence and want to do the insertion right there.
3586 else
3590 -- If parent is a body or a spec or a block, then the current
3591 -- node is a statement or declaration and we can insert the
3592 -- freeze node before it.
3594 when N_Package_Specification |
3595 N_Package_Body |
3596 N_Subprogram_Body |
3597 N_Task_Body |
3598 N_Protected_Body |
3599 N_Entry_Body |
3602 -- The expander is allowed to define types in any statements list,
3603 -- so any of the following parent nodes also mark a freezing point
3604 -- if the actual node is in a list of statements or declarations.
3606 when N_Exception_Handler |
3607 N_If_Statement |
3608 N_Elsif_Part |
3609 N_Case_Statement_Alternative |
3610 N_Compilation_Unit_Aux |
3611 N_Selective_Accept |
3612 N_Accept_Alternative |
3613 N_Delay_Alternative |
3614 N_Conditional_Entry_Call |
3615 N_Entry_Call_Alternative |
3616 N_Triggering_Alternative |
3617 N_Abortable_Part |
3618 N_Freeze_Entity =>
3622 -- Note: The N_Loop_Statement is a special case. A type that
3623 -- appears in the source can never be frozen in a loop (this
3624 -- occurs only because of a loop expanded by the expander),
3625 -- so we keep on going. Otherwise we terminate the search.
3626 -- Same is true of any entity which comes from source. (if they
3627 -- have a predefined type, that type does not appear to come
3628 -- from source, but the entity should not be frozen here).
3634 -- For all other cases, keep looking at parents
3640 -- We fall through the case if we did not yet find the proper
3641 -- place in the free for inserting the freeze node, so climb!
3646 -- If the expression appears in a record or an initialization
3647 -- procedure, the freeze nodes are collected and attached to
3648 -- the current scope, to be inserted and analyzed on exit from
3649 -- the scope, to insure that generated entities appear in the
3650 -- correct scope. If the expression is a default for a discriminant
3651 -- specification, the scope is still void. The expression can also
3652 -- appear in the discriminant part of a private or concurrent type.
3654 -- The other case requiring this special handling is if we are in
3655 -- a default expression, since in that case we are about to freeze
3656 -- a static type, and the freeze scope needs to be the outer scope,
3657 -- not the scope of the subprogram with the default parameter.
3659 -- For default expressions in generic units, the Move_Freeze_Nodes
3660 -- mechanism (see sem_ch12.adb) takes care of placing them at the
3661 -- proper place, after the generic unit.
3664 or else Freeze_Outside
3669 then
3670 declare
3674 begin
3690 then
3691 Scope_Stack.Table
3693 Freeze_Nodes;
3694 else
3704 -- Now we have the right place to do the freezing. First, a special
3705 -- adjustment, if we are in default expression analysis mode, these
3706 -- freeze actions must not be thrown away (normally all inserted
3707 -- actions are thrown away in this mode. However, the freeze actions
3708 -- are from static expressions and one of the important reasons we
3709 -- are doing this special analysis is to get these freeze actions.
3710 -- Therefore we turn off the In_Default_Expression mode to propagate
3711 -- these freeze actions. This also means they get properly analyzed
3712 -- and expanded.
3716 -- Freeze the designated type of an allocator (RM 13.14(13))
3722 -- Freeze type of expression (RM 13.14(10)). Note that we took care of
3723 -- the enumeration representation clause exception in the loop above.
3729 -- Freeze name if one is present (RM 13.14(11))
3738 -----------------------------
3739 -- Freeze_Fixed_Point_Type --
3740 -----------------------------
3742 -- Certain fixed-point types and subtypes, including implicit base
3743 -- types and declared first subtypes, have not yet set up a range.
3744 -- This is because the range cannot be set until the Small and Size
3745 -- values are known, and these are not known till the type is frozen.
3747 -- To signal this case, Scalar_Range contains an unanalyzed syntactic
3748 -- range whose bounds are unanalyzed real literals. This routine will
3749 -- recognize this case, and transform this range node into a properly
3750 -- typed range with properly analyzed and resolved values.
3768 -- Returns size of type with given bounds. Also leaves these
3769 -- bounds set as the current bounds of the Typ.
3771 -----------
3772 -- Fsize --
3773 -----------
3776 begin
3782 -- Start of processing for Freeze_Fixed_Point_Type
3784 begin
3785 -- If Esize of a subtype has not previously been set, set it now
3792 else
3797 -- Immediate return if the range is already analyzed. This means
3798 -- that the range is already set, and does not need to be computed
3799 -- by this routine.
3805 -- Immediate return if either of the bounds raises Constraint_Error
3809 then
3816 -- Ordinary fixed-point case
3820 -- For the ordinary fixed-point case, we are allowed to fudge the
3821 -- end-points up or down by small. Generally we prefer to fudge
3822 -- up, i.e. widen the bounds for non-model numbers so that the
3823 -- end points are included. However there are cases in which this
3824 -- cannot be done, and indeed cases in which we may need to narrow
3825 -- the bounds. The following circuit makes the decision.
3827 -- Note: our terminology here is that Incl_EP means that the
3828 -- bounds are widened by Small if necessary to include the end
3829 -- points, and Excl_EP means that the bounds are narrowed by
3830 -- Small to exclude the end-points if this reduces the size.
3832 -- Note that in the Incl case, all we care about is including the
3833 -- end-points. In the Excl case, we want to narrow the bounds as
3834 -- much as permitted by the RM, to give the smallest possible size.
3851 begin
3852 -- First step. Base types are required to be symmetrical. Right
3853 -- now, the base type range is a copy of the first subtype range.
3854 -- This will be corrected before we are done, but right away we
3855 -- need to deal with the case where both bounds are non-negative.
3856 -- In this case, we set the low bound to the negative of the high
3857 -- bound, to make sure that the size is computed to include the
3858 -- required sign. Note that we do not need to worry about the
3859 -- case of both bounds negative, because the sign will be dealt
3860 -- with anyway. Furthermore we can't just go making such a bound
3861 -- symmetrical, since in a twos-complement system, there is an
3862 -- extra negative value which could not be accomodated on the
3863 -- positive side.
3868 then
3873 -- Compute the fudged bounds. If the number is a model number,
3874 -- then we do nothing to include it, but we are allowed to
3875 -- backoff to the next adjacent model number when we exclude
3876 -- it. If it is not a model number then we straddle the two
3877 -- values with the model numbers on either side.
3883 else
3887 -- The low value excluding the end point is Small greater, but
3888 -- we do not do this exclusion if the low value is positive,
3889 -- since it can't help the size and could actually hurt by
3890 -- crossing the high bound.
3894 else
3898 -- Similar processing for upper bound and high value
3904 else
3910 else
3914 -- One further adjustment is needed. In the case of subtypes,
3915 -- we cannot go outside the range of the base type, or we get
3916 -- peculiarities, and the base type range is already set. This
3917 -- only applies to the Incl values, since clearly the Excl
3918 -- values are already as restricted as they are allowed to be.
3925 -- Get size including and excluding end points
3930 -- No need to exclude end-points if it does not reduce size
3940 -- Now we set the actual size to be used. We want to use the
3941 -- bounds fudged up to include the end-points but only if this
3942 -- can be done without violating a specifically given size
3943 -- size clause or causing an unacceptable increase in size.
3945 -- Case of size clause given
3949 -- Use the inclusive size only if it is consistent with
3950 -- the explicitly specified size.
3957 -- If the inclusive size is too large, we try excluding
3958 -- the end-points (will be caught later if does not work).
3960 else
3966 -- Case of size clause not given
3968 else
3969 -- If we have a base type whose corresponding first subtype
3970 -- has an explicit size that is large enough to include our
3971 -- end-points, then do so. There is no point in working hard
3972 -- to get a base type whose size is smaller than the specified
3973 -- size of the first subtype.
3979 then
3984 -- If excluding the end-points makes the size smaller and
3985 -- results in a size of 8,16,32,64, then we take the smaller
3986 -- size. For the 64 case, this is compulsory. For the other
3987 -- cases, it seems reasonable. We like to include end points
3988 -- if we can, but not at the expense of moving to the next
3989 -- natural boundary of size.
3992 and then
3997 then
4002 -- Otherwise we can definitely include the end points
4004 else
4010 -- One pathological case: normally we never fudge a low
4011 -- bound down, since it would seem to increase the size
4012 -- (if it has any effect), but for ranges containing a
4013 -- single value, or no values, the high bound can be
4014 -- small too large. Consider:
4016 -- type t is delta 2.0**(-14)
4017 -- range 131072.0 .. 0;
4019 -- That lower bound is *just* outside the range of 32
4020 -- bits, and does need fudging down in this case. Note
4021 -- that the bounds will always have crossed here, since
4022 -- the high bound will be fudged down if necessary, as
4023 -- in the case of:
4025 -- type t is delta 2.0**(-14)
4026 -- range 131072.0 .. 131072.0;
4028 -- So we can detect the situation by looking for crossed
4029 -- bounds, and if the bounds are crossed, and the low
4030 -- bound is greater than zero, we will always back it
4031 -- off by small, since this is completely harmless.
4038 -- And of course, we need to do exactly the same parallel
4039 -- fudge for flat ranges in the negative region.
4052 -- For the decimal case, none of this fudging is required, since there
4053 -- are no end-point problems in the decimal case (the end-points are
4054 -- always included).
4056 else
4060 -- At this stage, the actual size has been calculated and the proper
4061 -- required bounds are stored in the low and high bounds.
4065 Error_Msg_N
4070 -- Check size against explicit given size
4076 Error_Msg_NE
4080 else
4084 -- Increase size to next natural boundary if no size clause given
4086 else
4093 else
4101 -- If we have a base type, then expand the bounds so that they
4102 -- extend to the full width of the allocated size in bits, to
4103 -- avoid junk range checks on intermediate computations.
4110 -- Final step is to reanalyze the bounds using the proper type
4111 -- and set the Corresponding_Integer_Value fields of the literals.
4117 -- Resolve with universal fixed if the base type, and the base
4118 -- type if it is a subtype. Note we can't resolve the base type
4119 -- with itself, that would be a reference before definition.
4123 else
4127 -- Set corresponding integer value for bound
4129 Set_Corresponding_Integer_Value
4132 -- Similar processing for high bound
4140 else
4144 Set_Corresponding_Integer_Value
4147 -- Set type of range to correspond to bounds
4151 -- Set Esize to calculated size if not set already
4157 -- Set RM_Size if not already set. If already set, check value
4159 declare
4162 begin
4167 Error_Msg_NE
4172 else
4178 ------------------
4179 -- Freeze_Itype --
4180 ------------------
4185 begin
4194 --------------------------
4195 -- Freeze_Static_Object --
4196 --------------------------
4201 -- Exception raised if the type of a static object cannot be made
4202 -- static. This happens if the type depends on non-global objects.
4205 -- Called to ensure that an expression used as part of a type
4206 -- definition is statically allocatable, which means that the type
4207 -- of the expression is statically allocatable, and the expression
4208 -- is either static, or a reference to a library level constant.
4211 -- Called to mark a type as static, checking that it is possible
4212 -- to set the type as static. If it is not possible, then the
4213 -- exception Cannot_Be_Static is raised.
4215 -----------------------------
4216 -- Ensure_Expression_Is_SA --
4217 -----------------------------
4222 begin
4234 then
4242 -----------------------
4243 -- Ensure_Type_Is_SA --
4244 -----------------------
4250 begin
4251 -- If type is library level, we are all set
4257 -- We are also OK if the type is already marked as statically
4258 -- allocated, which means we processed it before.
4264 -- Mark type as statically allocated
4268 -- Check that it is safe to statically allocate this type
4286 declare
4290 begin
4303 else
4313 then
4332 else
4337 -- Start of processing for Freeze_Static_Object
4339 begin
4342 -- Reset True_Constant flag, since something strange is going on
4343 -- with the scoping here, and our simple value tracing may not
4344 -- be sufficient for this indication to be reliable. We kill the
4345 -- Constant_Value indication for the same reason.
4350 exception
4353 -- If the object that cannot be static is imported or exported,
4354 -- then we give an error message saying that this object cannot
4355 -- be imported or exported.
4358 Error_Msg_N
4361 -- Otherwise must be exported, something is wrong if compiler
4362 -- is marking something as statically allocated which cannot be).
4365 Error_Msg_N
4370 -----------------------
4371 -- Freeze_Subprogram --
4372 -----------------------
4378 begin
4379 -- Subprogram may not have an address clause unless it is imported
4383 Error_Msg_N
4390 -- Reset the Pure indication on an imported subprogram unless an
4391 -- explicit Pure_Function pragma was present. We do this because
4392 -- otherwise it is an insidious error to call a non-pure function
4393 -- from a pure unit and have calls mysteriously optimized away.
4394 -- What happens here is that the Import can bypass the normal
4395 -- check to ensure that pure units call only pure subprograms.
4400 then
4404 -- For non-foreign convention subprograms, this is where we create
4405 -- the extra formals (for accessibility level and constrained bit
4406 -- information). We delay this till the freeze point precisely so
4407 -- that we know the convention!
4413 -- If this is convention Ada and a Valued_Procedure, that's odd
4418 and then Warn_On_Export_Import
4419 then
4420 Error_Msg_N
4425 -- Case of foreign convention
4427 else
4430 -- For foreign conventions, warn about return of an
4431 -- unconstrained array.
4433 -- Note: we *do* allow a return by descriptor for the VMS case,
4434 -- though here there is probably more to be done ???
4439 -- If no return type, probably some other error, e.g. a
4440 -- missing full declaration, so ignore.
4445 -- If the return type is generic, we have emitted a warning
4446 -- earlier on, and there is nothing else to check here.
4447 -- Specific instantiations may lead to erroneous behavior.
4455 and then Warn_On_Export_Import
4456 then
4457 Error_Msg_N
4464 -- If any of the formals for an exported foreign convention
4465 -- subprogram have defaults, then emit an appropriate warning
4466 -- since this is odd (default cannot be used from non-Ada code)
4471 if Warn_On_Export_Import
4473 then
4474 Error_Msg_N
4484 -- For VMS, descriptor mechanisms for parameters are allowed only
4485 -- for imported subprograms.
4492 Error_Msg_N
4494 Error_Msg_N
4504 ----------------------
4505 -- Is_Fully_Defined --
4506 ----------------------
4509 begin
4518 then
4519 -- Verify that the record type has no components with
4520 -- private types without completion.
4522 declare
4525 begin
4543 ---------------------------------
4544 -- Process_Default_Expressions --
4545 ---------------------------------
4547 procedure Process_Default_Expressions
4550 is
4557 begin
4560 -- A subprogram instance and its associated anonymous subprogram
4561 -- share their signature. The default expression functions are defined
4562 -- in the wrapper packages for the anonymous subprogram, and should
4563 -- not be generated again for the instance.
4568 then
4577 -- We work with a copy of the default expression because we
4578 -- do not want to disturb the original, since this would mess
4579 -- up the conformance checking.
4583 -- The analysis of the expression may generate insert actions,
4584 -- which of course must not be executed. We wrap those actions
4585 -- in a procedure that is not called, and later on eliminated.
4586 -- The following cases have no side-effects, and are analyzed
4587 -- directly.
4598 and then
4600 then
4602 -- If there is no default function, we must still do a full
4603 -- analyze call on the default value, to ensure that all
4604 -- error checks are performed, e.g. those associated with
4605 -- static evaluation. Note that this branch will always be
4606 -- taken if the analyzer is turned off (but we still need the
4607 -- error checks).
4609 -- Note: the setting of parent here is to meet the requirement
4610 -- that we can only analyze the expression while attached to
4611 -- the tree. Really the requirement is that the parent chain
4612 -- be set, we don't actually need to be in the tree.
4617 -- Default expressions are resolved with their own type if the
4618 -- context is generic, to avoid anomalies with private types.
4622 else
4626 -- If that resolved expression will raise constraint error,
4627 -- then flag the default value as raising constraint error.
4628 -- This allows a proper error message on the calls.
4634 -- If the default is a parameterless call, we use the name of
4635 -- the called function directly, and there is no body to build.
4639 then
4642 -- Else construct and analyze the body of a wrapper procedure
4643 -- that contains an object declaration to hold the expression.
4644 -- Given that this is done only to complete the analysis, it
4645 -- simpler to build a procedure than a function which might
4646 -- involve secondary stack expansion.
4648 else
4649 Dnam :=
4652 Dbody :=
4654 Specification =>
4660 Defining_Identifier =>
4663 Object_Definition =>
4667 Handled_Statement_Sequence =>
4685 ----------------------------------------
4686 -- Set_Component_Alignment_If_Not_Set --
4687 ----------------------------------------
4690 begin
4691 -- Ignore if not base type, subtypes don't need anything
4697 -- Do not override existing representation
4708 else
4709 Set_Component_Alignment
4715 ---------------------------
4716 -- Set_Debug_Info_Needed --
4717 ---------------------------
4720 begin
4724 then
4726 else
4737 declare
4739 begin
4749 declare
4751 begin
4774 ------------------
4775 -- Undelay_Type --
4776 ------------------
4779 begin
4783 -- Since we don't want T to have a Freeze_Node, we don't want its
4784 -- Full_View or Corresponding_Record_Type to have one either.
4786 -- ??? Fundamentally, this whole handling is a kludge. What we really
4787 -- want is to be sure that for an Itype that's part of record R and
4788 -- is a subtype of type T, that it's frozen after the later of the
4789 -- freeze points of R and T. We have no way of doing that directly,
4790 -- so what we do is force most such Itypes to be frozen as part of
4791 -- freezing R via this procedure and only delay the ones that need
4792 -- to be delayed (mostly the designated types of access types that are
4793 -- defined as part of the record).
4799 then
4807 then
4812 ------------------
4813 -- Warn_Overlay --
4814 ------------------
4816 procedure Warn_Overlay
4820 is
4822 -- The object to which the address clause applies.
4828 begin
4829 -- No warning if address clause overlay warnings are off
4835 -- No warning if there is an explicit initialization
4843 -- We only give the warning for non-imported entities of a type
4844 -- for which a non-null base init proc is defined (or for access
4845 -- types which have implicit null initialization).
4851 then
4854 then
4859 then
4866 then
4873 -- A function call (most likely to To_Address) is probably not
4874 -- an overlay, so skip warning. Ditto if the function call was
4875 -- inlined and transformed into an entity.
4883 -- If a pragma Import follows, we assume that it is for the current
4884 -- target of the address clause, and skip the warning.
4889 then
4895 Error_Msg_N
4897 Nam);
4898 else
4899 Error_Msg_N
4901 Nam);
4904 -- Add friendly warning if initialization comes from a packed array
4905 -- component.
4908 declare
4911 begin
4917 then
4921 then
4922 Error_Msg_NE
4926 else
4933 Error_Msg_N
4936 Nam);