| blob | 579c5ff509022702c6c8e1695cb05a580c8e36eb |
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-2002, 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 ------------------------------------------------------------------------------
64 -----------------------
65 -- Local Subprograms --
66 -----------------------
69 -- Typ is a type that is being frozen. If no size clause is given,
70 -- but a default Esize has been computed, then this default Esize is
71 -- adjusted up if necessary to be consistent with a given alignment,
72 -- but never to a value greater than Long_Long_Integer'Size. This
73 -- is used for all discrete types and for fixed-point types.
75 procedure Build_And_Analyze_Renamed_Body
79 -- Build body for a renaming declaration, insert in tree and analyze.
82 -- E is a base type. If E is tagged or has a component that is aliased
83 -- or tagged or contains something this is aliased or tagged, set
84 -- Strict_Alignment.
88 -- If E is a fixed-point or discrete type, then all the necessary work
89 -- to freeze it is completed except for possible setting of the flag
90 -- Is_Unsigned_Type, which is done by this procedure. The call has no
91 -- effect if the entity E is not a discrete or fixed-point type.
93 procedure Freeze_And_Append
97 -- Freezes Ent using Freeze_Entity, and appends the resulting list of
98 -- nodes to Result, modifying Result from No_List if necessary.
101 -- Freeze enumeration type. The Esize field is set as processing
102 -- proceeds (i.e. set by default when the type is declared and then
103 -- adjusted by rep clauses. What this procedure does is to make sure
104 -- that if a foreign convention is specified, and no specific size
105 -- is given, then the size must be at least Integer'Size.
108 -- If an object is frozen which has Is_Statically_Allocated set, then
109 -- all referenced types must also be marked with this flag. This routine
110 -- is in charge of meeting this requirement for the object entity E.
113 -- Perform freezing actions for a subprogram (create extra formals,
114 -- and set proper default mechanism values). Note that this routine
115 -- is not called for internal subprograms, for which neither of these
116 -- actions is needed (or desirable, we do not want for example to have
117 -- these extra formals present in initialization procedures, where they
118 -- would serve no purpose). In this call E is either a subprogram or
119 -- a subprogram type (i.e. an access to a subprogram).
122 -- true if T is not private, or has a full view.
124 procedure Process_Default_Expressions
127 -- This procedure is called for each subprogram to complete processing
128 -- of default expressions at the point where all types are known to be
129 -- frozen. The expressions must be analyzed in full, to make sure that
130 -- all error processing is done (they have only been pre-analyzed). If
131 -- the expression is not an entity or literal, its analysis may generate
132 -- code which must not be executed. In that case we build a function
133 -- body to hold that code. This wrapper function serves no other purpose
134 -- (it used to be called to evaluate the default, but now the default is
135 -- inlined at each point of call).
138 -- Typ is a record or array type that is being frozen. This routine
139 -- sets the default component alignment from the scope stack values
140 -- if the alignment is otherwise not specified.
143 -- As each entity is frozen, this routine is called to deal with the
144 -- setting of Debug_Info_Needed for the entity. This flag is set if
145 -- the entity comes from source, or if we are in Debug_Generated_Code
146 -- mode or if the -gnatdV debug flag is set. However, it never sets
147 -- the flag if Debug_Info_Off is set.
150 -- Sets the Debug_Info_Needed flag on entity T if not already set, and
151 -- also on any entities that are needed by T (for an object, the type
152 -- of the object is needed, and for a type, the subsidiary types are
153 -- needed -- see body for details). Never has any effect on T if the
154 -- Debug_Info_Off flag is set.
156 -------------------------------
157 -- Adjust_Esize_For_Alignment --
158 -------------------------------
163 begin
169 then
175 ------------------------------------
176 -- Build_And_Analyze_Renamed_Body --
177 ------------------------------------
179 procedure Build_And_Analyze_Renamed_Body
183 is
186 begin
193 ------------------------
194 -- Build_Renamed_Body --
195 ------------------------
197 function Build_Renamed_Body
200 return Node_Id
201 is
203 -- We use for the source location of the renamed body, the location
204 -- of the spec entity. It might seem more natural to use the location
205 -- of the renaming declaration itself, but that would be wrong, since
206 -- then the body we create would look as though it was created far
207 -- too late, and this could cause problems with elaboration order
208 -- analysis, particularly in connection with instantiations.
222 begin
223 -- Determine the entity being renamed, which is the target of the
224 -- call statement. If the name is an explicit dereference, this is
225 -- a renaming of a subprogram type rather than a subprogram. The
226 -- name itself is fully analyzed.
238 else
245 else
251 -- If the renamed entity is a predefined operator, retain full
252 -- name to ensure its visibility.
256 then
258 else
262 else
265 -- The original name may have been overloaded, but
266 -- is fully resolved now.
271 -- For simple renamings, subsequent calls can be expanded directly
272 -- as called to the renamed entity. The body must be generated in
273 -- any case for calls they may appear elsewhere.
278 then
282 -- The body generated for this renaming is an internal artifact, and
283 -- does not constitute a freeze point for the called entity.
298 -- If the renamed entity is an entry, inherit its profile. For
299 -- other renamings as bodies, both profiles must be subtype
300 -- conformant, so it is not necessary to replace the profile given
301 -- in the declaration. However, default values that are aggregates
302 -- are rewritten when partially analyzed, so we recover the original
303 -- aggregate to insure that subsequent conformity checking works.
304 -- Similarly, if the default expression was constant-folded, recover
305 -- the original expression.
317 N_Access_Definition
318 then
326 then
337 -- If the renamed entity is a function, the generated body contains a
338 -- return statement. Otherwise, build a procedure call. If the entity is
339 -- an entry, subsequent analysis of the call will transform it into the
340 -- proper entry or protected operation call. If the renamed entity is
341 -- a character literal, return it directly.
347 then
348 Call_Node :=
350 Expression =>
356 Call_Node :=
361 Call_Node :=
365 else
366 Call_Node :=
372 -- Create entities for subprogram body and formals.
386 Body_Node :=
390 Handled_Statement_Sequence =>
400 -- Link the body to the entity whose declaration it completes. If
401 -- the body is analyzed when the renamed entity is frozen, it may be
402 -- necessary to restore the proper scope (see package Exp_Ch13).
406 then
408 else
415 -----------------------------
416 -- Check_Compile_Time_Size --
417 -----------------------------
422 -- Sets the compile time known size (32 bits or less) in the Esize
423 -- field, checking for a size clause that was given which attempts
424 -- to give a smaller size.
427 -- Recursive function that does all the work
430 -- If T is a constrained subtype, its size is not known if any of its
431 -- discriminant constraints is not static and it is not a null record.
432 -- The test is conservative and doesn't check that the components are
433 -- in fact constrained by non-static discriminant values. Could be made
434 -- more precise ???
436 --------------------
437 -- Set_Small_Size --
438 --------------------
441 begin
448 Error_Msg_NE
456 -- Set sizes if not set already
458 else
469 ----------------
470 -- Size_Known --
471 ----------------
480 begin
486 then
498 -- Don't do any recursion on type with error posted, since
499 -- we may have a malformed type that leads us into a loop
508 -- Check for all indexes static, and also compute possible
509 -- size (in case it is less than 32 and may be packable).
511 declare
515 begin
525 else
533 then
536 else
541 else
559 then
560 -- Don't do any recursion on type with error posted, since
561 -- we may have a malformed type that leads us into a loop
565 else
577 -- Don't do any recursion on type with error posted, since
578 -- we may have a malformed type that leads us into a loop
583 else
584 declare
588 begin
589 -- Test for variant part present
595 N_Record_Definition
599 then
600 -- If variant part is present, and type is unconstrained,
601 -- then we must have defaulted discriminants, or a size
602 -- clause must be present for the type, or else the size
603 -- is definitely not known at compile time.
606 and then
607 No (Discriminant_Default_Value
610 then
612 else
613 -- We do not know the packed size, it is too much
614 -- trouble to figure it out.
624 or else
626 then
638 -- If RM_Size is known and static, then we can
639 -- keep accumulating the packed size.
643 -- A little glitch, to be removed sometime ???
644 -- gigi does not understand zero sizes yet.
650 Packed_Size :=
653 -- If we have a field whose RM_Size is not known
654 -- then we can't figure out the packed size here.
656 else
673 else
678 -------------------------------------
679 -- Static_Discriminated_Components --
680 -------------------------------------
682 function Static_Discriminated_Components
685 is
688 begin
692 then
707 -- Start of processing for Check_Compile_Time_Size
709 begin
713 -----------------------------
714 -- Check_Debug_Info_Needed --
715 -----------------------------
718 begin
723 or else Debug_Generated_Code
724 or else Debug_Flag_VV
725 then
730 ----------------------------
731 -- Check_Strict_Alignment --
732 ----------------------------
737 begin
756 then
766 -------------------------
767 -- Check_Unsigned_Type --
768 -------------------------
775 begin
780 -- Do not attempt to analyze case where range was in error
786 -- The situation that is non trivial is something like
788 -- subtype x1 is integer range -10 .. +10;
789 -- subtype x2 is x1 range 0 .. V1;
790 -- subtype x3 is x2 range V2 .. V3;
791 -- subtype x4 is x3 range V4 .. V5;
793 -- where Vn are variables. Here the base type is signed, but we still
794 -- know that x4 is unsigned because of the lower bound of x2.
796 -- The only way to deal with this is to look up the ancestor chain
799 loop
814 else
817 -- If no ancestor had a static lower bound, go to base type
821 -- Note: the reason we still check for a compile time known
822 -- value for the base type is that at least in the case of
823 -- generic formals, we can have bounds that fail this test,
824 -- and there may be other cases in error situations.
836 then
847 ----------------
848 -- Freeze_All --
849 ----------------
851 -- Note: the easy coding for this procedure would be to just build a
852 -- single list of freeze nodes and then insert them and analyze them
853 -- all at once. This won't work, because the analysis of earlier freeze
854 -- nodes may recursively freeze types which would otherwise appear later
855 -- on in the freeze list. So we must analyze and expand the freeze nodes
856 -- as they are generated.
864 -- This is the internal recursive routine that does freezing of
865 -- entities (but NOT the analysis of default expressions, which
866 -- should not be recursive, we don't want to analyze those till
867 -- we are sure that ALL the types are frozen).
869 procedure Freeze_All_Ent
872 is
878 -- If freeze nodes are present, insert and analyze, and reset
879 -- cursor for next insertion.
882 begin
889 else
895 begin
899 -- If the entity is an inner package which is not a package
900 -- renaming, then its entities must be frozen at this point.
901 -- Note that such entities do NOT get frozen at the end of
902 -- the nested package itself (only library packages freeze).
904 -- Same is true for task declarations, where anonymous records
905 -- created for entry parameters must be frozen.
911 then
921 and then
923 or else
925 then
928 End_Scope;
930 -- For a derived tagged type, we must ensure that all the
931 -- primitive operations of the parent have been frozen, so
932 -- that their addresses will be in the parent's dispatch table
933 -- at the point it is inherited.
939 then
940 declare
946 begin
954 then
956 Process_Flist;
966 Process_Flist;
973 -- Start of processing for Freeze_All
975 begin
978 -- Now that all types are frozen, we can deal with default expressions
979 -- that require us to build a default expression functions. This is the
980 -- point at which such functions are constructed (after all types that
981 -- might be used in such expressions have been frozen).
982 -- We also add finalization chains to access types whose designated
983 -- types are controlled. This is normally done when freezing the type,
984 -- but this misses recursive type definitions where the later members
985 -- of the recursion introduce controlled components (e.g. 5624-001).
987 -- Loop through entities
1006 and then
1008 = N_Subprogram_Renaming_Declaration
1009 then
1010 Build_And_Analyze_Renamed_Body
1016 and then
1018 or else
1020 then
1021 declare
1024 begin
1031 then
1044 then
1053 -----------------------
1054 -- Freeze_And_Append --
1055 -----------------------
1057 procedure Freeze_And_Append
1061 is
1064 begin
1068 else
1074 -------------------
1075 -- Freeze_Before --
1076 -------------------
1082 begin
1092 -------------------
1093 -- Freeze_Entity --
1094 -------------------
1105 -- Check that an Access or Unchecked_Access attribute with
1106 -- a prefix which is the current instance type can only be
1107 -- applied when the type is limited.
1110 -- If Loc is a freeze_entity that appears after the last declaration
1111 -- in the scope, inhibit error messages on late completion.
1114 -- Freeze each component, handle some representation clauses, and
1115 -- freeze primitive operations if this is a tagged type.
1117 ----------------------------
1118 -- After_Last_Declaration --
1119 ----------------------------
1124 begin
1131 else
1135 else
1140 ----------------------------
1141 -- Check_Current_Instance --
1142 ----------------------------
1147 -- Process routine to apply check to given node.
1150 begin
1154 or else
1159 then
1160 Error_Msg_N
1163 else
1173 -- Start of processing for Check_Current_Instance
1175 begin
1179 ------------------------
1180 -- Freeze_Record_Type --
1181 ------------------------
1189 -- Set True if we find at least one component with no component
1190 -- clause (used to warn about useless Pack pragmas).
1193 -- Set True if we find at least one component with a component
1194 -- clause (used to warn about useless Bit_Order pragmas).
1196 begin
1197 -- Freeze components and embedded subtypes
1207 -- If the component is an access type with an allocator
1208 -- as default value, the designated type will be frozen
1209 -- by the corresponding expression in init_proc. In order
1210 -- to place the freeze node for the designated type before
1211 -- that for the current record type, freeze it now.
1213 -- Same process if the component is an array of access types,
1214 -- initialized with an aggregate. If the designated type is
1215 -- private, it cannot contain allocators, and it is premature
1216 -- to freeze the type, so we check for this as well.
1222 then
1223 declare
1226 begin
1227 -- If component is pointer to a classwide type, freeze
1228 -- the specific type in the expression being allocated.
1229 -- The expression may be a subtype indication, in which
1230 -- case freeze the subtype mark.
1235 Freeze_And_Append
1237 elsif
1239 then
1240 Freeze_And_Append
1244 else
1245 Freeze_And_Append
1250 -- If this is a constrained subtype of an already frozen type,
1251 -- make the subtype frozen as well. It might otherwise be frozen
1252 -- in the wrong scope, and a freeze node on subtype has no effect.
1258 then
1267 and then Is_Fully_Defined
1269 then
1270 Freeze_And_Append
1271 (Designated_Type
1275 -- Processing for real components (exclude anonymous subtypes)
1279 then
1280 -- Check for error of component clause given for variable
1281 -- sized type. We have to delay this test till this point,
1282 -- since the component type has to be frozen for us to know
1283 -- if it is variable length. We omit this test in a generic
1284 -- context, it will be applied at instantiation time.
1286 declare
1289 begin
1296 elsif not Size_Known_At_Compile_Time
1298 then
1299 Error_Msg_N
1304 else
1309 -- If component clause is present, then deal with the
1310 -- non-default bit order case. We cannot do this before
1311 -- the freeze point, because there is no required order
1312 -- for the component clause and the bit_order clause.
1314 -- We only do this processing for the base type, and in
1315 -- fact that's important, since otherwise if there are
1316 -- record subtypes, we could reverse the bits once for
1317 -- each subtype, which would be incorrect.
1322 then
1323 declare
1336 begin
1337 -- Cases where field goes over storage unit boundary
1341 -- Allow multi-byte field but generate warning
1345 then
1346 Error_Msg_N
1351 Error_Msg_N
1354 else
1355 Error_Msg_N
1360 -- Do not allow non-contiguous field
1362 else
1363 Error_Msg_N
1366 Error_Msg_N
1371 -- Case where field fits in one storage unit
1373 else
1374 -- Give warning if suspicious component clause
1377 Error_Msg_N
1380 Error_Msg_Uint_1 :=
1382 Error_Msg_N
1387 -- Here is where we fix up the Component_Bit_Offset
1388 -- value to account for the reverse bit order.
1389 -- Some examples of what needs to be done are:
1391 -- First_Bit .. Last_Bit Component_Bit_Offset
1392 -- old new old new
1394 -- 0 .. 0 7 .. 7 0 7
1395 -- 0 .. 1 6 .. 7 0 6
1396 -- 0 .. 2 5 .. 7 0 5
1397 -- 0 .. 7 0 .. 7 0 4
1399 -- 1 .. 1 6 .. 6 1 6
1400 -- 1 .. 4 3 .. 6 1 3
1401 -- 4 .. 7 0 .. 3 4 0
1403 -- The general rule is that the first bit is
1404 -- is obtained by subtracting the old ending bit
1405 -- from storage_unit - 1.
1422 -- Check for useless pragma Bit_Order
1430 -- Check for useless pragma Pack when all components placed
1433 and then not Unplaced_Component
1434 and then Warn_On_Redundant_Constructs
1435 then
1436 Error_Msg_N
1442 -- If this is the record corresponding to a remote type,
1443 -- freeze the remote type here since that is what we are
1444 -- semantically freeing. This prevents having the freeze node
1445 -- for that type in an inner scope.
1447 -- Also, Check for controlled components and unchecked unions.
1448 -- Finally, enforce the restriction that access attributes with
1449 -- a current instance prefix can only apply to limited types.
1454 Freeze_And_Append
1465 and then Present
1467 and then Has_Controlled_Component
1469 then
1480 then
1481 -- Scan component declaration for likely misuses of
1482 -- current instance, either in a constraint or in a
1483 -- default expression.
1494 -- For first subtypes, check if there are any fixed-point
1495 -- fields with component clauses, where we must check the size.
1496 -- This is not done till the freeze point, since for fixed-point
1497 -- types, we do not know the size until the type is frozen.
1505 then
1506 Check_Size
1510 Junk);
1518 -- Start of processing for Freeze_Entity
1520 begin
1521 -- Do not freeze if already frozen since we only need one freeze node.
1526 -- It is improper to freeze an external entity within a generic
1527 -- because its freeze node will appear in a non-valid context.
1528 -- ??? We should probably freeze the entity at that point and insert
1529 -- the freeze node in a proper place but this proper place is not
1530 -- easy to find, and the proper scope is not easy to restore. For
1531 -- now, just wait to get out of the generic to freeze ???
1536 -- Do not freeze a global entity within an inner scope created during
1537 -- expansion. A call to subprogram E within some internal procedure
1538 -- (a stream attribute for example) might require freezing E, but the
1539 -- freeze node must appear in the same declarative part as E itself.
1540 -- The two-pass elaboration mechanism in gigi guarantees that E will
1541 -- be frozen before the inner call is elaborated. We exclude constants
1542 -- from this test, because deferred constants may be frozen early, and
1543 -- must be diagnosed (see e.g. 1522-005). If the enclosing subprogram
1544 -- comes from source, or is a generic instance, then the freeze point
1545 -- is the one mandated by the language. and we freze the entity.
1550 then
1551 declare
1554 begin
1559 then
1561 else
1571 -- Here to freeze the entity
1576 -- Case of entity being frozen is other than a type
1580 -- If entity is exported or imported and does not have an external
1581 -- name, now is the time to provide the appropriate default name.
1582 -- Skip this if the entity is stubbed, since we don't need a name
1583 -- for any stubbed routine.
1588 then
1589 Set_Encoded_Interface_Name
1593 -- For a subprogram, freeze all parameter types and also the return
1594 -- type (RM 13.14(13)). However skip this for internal subprograms.
1595 -- This is also the point where any extra formal parameters are
1596 -- created since we now know whether the subprogram will use
1597 -- a foreign convention.
1603 declare
1607 -- Determines if given type entity is a fat pointer type
1608 -- used as an argument type or return type to a subprogram
1609 -- with C or C++ convention set.
1611 --------------------------
1612 -- Is_Fat_C_Access_Type --
1613 --------------------------
1616 begin
1618 or else
1624 begin
1625 -- Loop through formals
1639 then
1640 -- If the type of a formal is incomplete, subprogram
1641 -- is being frozen prematurely. Within an instance
1642 -- (but not within a wrapper package) this is an
1643 -- an artifact of our need to regard the end of an
1644 -- instantiation as a freeze point. Otherwise it is
1645 -- a definite error.
1646 -- and then not Is_Wrapper_Package (Current_Scope) ???
1654 Error_Msg
1656 Loc);
1660 -- Check bad use of fat C pointer
1664 Error_Msg_N
1666 Formal);
1670 -- Check for unconstrained array in exported foreign
1671 -- convention case.
1677 then
1679 Error_Msg_N
1681 Formal);
1682 Error_Msg_N
1684 Formal);
1691 -- Check return type
1697 Error_Msg_N
1699 E);
1705 then
1706 Error_Msg_N
1714 -- Must freeze its parent first if it is a derived subprogram
1720 -- If the return type requires a transient scope, and we are on
1721 -- a target allowing functions to return with a depressed stack
1722 -- pointer, then we mark the function as requiring this treatment.
1725 and then Functions_Return_By_DSP_On_Target
1727 then
1735 -- Here for other than a subprogram or type
1737 else
1738 -- If entity has a type, and it is not a generic unit, then
1739 -- freeze it first (RM 13.14(10))
1743 then
1747 -- For object created by object declaration, perform required
1748 -- categorization (preelaborate and pure) checks. Defer these
1749 -- checks to freeze time since pragma Import inhibits default
1750 -- initialization and thus pragma Import affects these checks.
1756 -- Check that a constant which has a pragma Volatile[_Components]
1757 -- or Atomic[_Components] also has a pragma Import (RM C.6(13))
1759 -- Note: Atomic[_Components] also sets Volatile[_Components]
1764 then
1765 -- Make sure we actually have a pragma, and have not merely
1766 -- inherited the indication from elsewhere (e.g. an address
1767 -- clause, which is not good enough in RM terms!)
1773 then
1774 Error_Msg_N
1776 E);
1780 -- Static objects require special handling
1784 then
1788 -- Remaining step is to layout objects
1791 or else
1793 or else
1795 or else
1797 then
1802 -- Case of a type or subtype being frozen
1804 else
1805 -- The type may be defined in a generic unit. This can occur when
1806 -- freezing a generic function that returns the type (which is
1807 -- defined in a parent unit). It is clearly meaningless to freeze
1808 -- this type. However, if it is a subtype, its size may be determi-
1809 -- nable and used in subsequent checks, so might as well try to
1810 -- compute it.
1814 then
1819 -- Deal with special cases of freezing for subtype
1823 -- If ancestor subtype present, freeze that first.
1824 -- Note that this will also get the base type frozen.
1831 -- Otherwise freeze the base type of the entity before
1832 -- freezing the entity itself, (RM 13.14(14)).
1838 -- For a derived type, freeze its parent type first (RM 13.14(14))
1845 -- For array type, freeze index types and component type first
1846 -- before freezing the array (RM 13.14(14)).
1849 declare
1853 -- Set true if any of the index types is an enumeration
1854 -- type with a non-standard representation.
1856 begin
1865 then
1872 -- Processing that is done only for base types
1876 -- Propagate flags for component type
1880 then
1888 -- If packing was requested or if the component size was set
1889 -- explicitly, then see if bit packing is required. This
1890 -- processing is only done for base types, since all the
1891 -- representation aspects involved are type-related. This
1892 -- is not just an optimization, if we start processing the
1893 -- subtypes, they intefere with the settings on the base
1894 -- type (this is because Is_Packed has a slightly different
1895 -- meaning before and after freezing).
1897 declare
1901 begin
1905 then
1914 else
1917 -- We can set the component size if it is less than
1918 -- 16, rounding it up to the next storage unit size.
1924 else
1928 -- Set component size up to match alignment if
1929 -- it would otherwise be less than the alignment.
1930 -- This deals with cases of types whose alignment
1931 -- exceeds their sizes (padded types).
1934 declare
1937 begin
1948 -- We set the component size for all cases 1-64
1952 -- Actual packing is not needed for 8,16,32,64
1953 -- Also not needed for 24 if alignment is 1
1960 then
1961 -- Here the array was requested to be packed, but
1962 -- the packing request had no effect, so Is_Packed
1963 -- is reset.
1965 -- Note: semantically this means that we lose
1966 -- track of the fact that a derived type inherited
1967 -- a pack pragma that was non-effective, but that
1968 -- seems fine.
1970 -- We regard a Pack pragma as a request to set a
1971 -- representation characteristic, and this request
1972 -- may be ignored.
1976 -- In all other cases, packing is indeed needed
1978 else
1986 -- Processing that is done only for subtypes
1988 else
1989 -- Acquire alignment from base type
1996 -- Check one common case of a size given where the array
1997 -- needs to be packed, but was not so the size cannot be
1998 -- honored. This would of course be caught by the backend,
1999 -- and indeed we don't catch all cases. The point is that
2000 -- we can give a better error message in those cases that
2001 -- we do catch with the circuitry here.
2009 then
2010 declare
2014 begin
2021 then
2022 declare
2028 begin
2031 then
2032 Error_Msg_NE
2035 Error_Msg_N
2044 -- If any of the index types was an enumeration type with
2045 -- a non-standard rep clause, then we indicate that the
2046 -- array type is always packed (even if it is not bit packed).
2056 -- If the array is packed, we must create the packed array
2057 -- type to be used to actually implement the type. This is
2058 -- only needed for real array types (not for string literal
2059 -- types, since they are present only for the front end).
2063 then
2067 -- Size information of packed array type is copied to the
2068 -- array type, since this is really the representation.
2074 -- For a class wide type, the corresponding specific type is
2075 -- frozen as well (RM 13.14(14))
2080 -- If the Class_Wide_Type is an Itype (when type is the anonymous
2081 -- parent of a derived type) and it is a library-level entity,
2082 -- generate an itype reference for it. Otherwise, its first
2083 -- explicit reference may be in an inner scope, which will be
2084 -- rejected by the back-end.
2088 then
2090 declare
2093 begin
2097 else
2103 -- For record (sub)type, freeze all the component types (RM
2104 -- 13.14(14). We test for E_Record_(sub)Type here, rather than
2105 -- using Is_Record_Type, because we don't want to attempt the
2106 -- freeze for the case of a private type with record extension
2107 -- (we will do that later when the full type is frozen).
2111 then
2114 -- For a concurrent type, freeze corresponding record type. This
2115 -- does not correpond to any specific rule in the RM, but the
2116 -- record type is essentially part of the concurrent type.
2117 -- Freeze as well all local entities. This includes record types
2118 -- created for entry parameter blocks, and whatever local entities
2119 -- may appear in the private part.
2123 Freeze_And_Append
2140 -- Private types are required to point to the same freeze node
2141 -- as their corresponding full views. The freeze node itself
2142 -- has to point to the partial view of the entity (because
2143 -- from the partial view, we can retrieve the full view, but
2144 -- not the reverse). However, in order to freeze correctly,
2145 -- we need to freeze the full view. If we are freezing at the
2146 -- end of a scope (or within the scope of the private type),
2147 -- the partial and full views will have been swapped, the
2148 -- full view appears first in the entity chain and the swapping
2149 -- mechanism enusres that the pointers are properly set (on
2150 -- scope exit).
2152 -- If we encounter the partial view before the full view
2153 -- (e.g. when freezing from another scope), we freeze the
2154 -- full view, and then set the pointers appropriately since
2155 -- we cannot rely on swapping to fix things up (subtypes in an
2156 -- outer scope might not get swapped).
2160 then
2161 -- Case of full view present
2165 -- If full view has already been frozen, then no
2166 -- further processing is required
2174 -- Otherwise freeze full view and patch the pointers
2176 else
2179 then
2180 Freeze_And_Append
2192 else
2193 -- {Incomplete,Private}_Subtypes
2194 -- with Full_Views constrained by discriminants
2204 -- AI-117 requires that the convention of a partial view
2205 -- be the same as the convention of the full view. Note
2206 -- that this is a recognized breach of privacy, but it's
2207 -- essential for logical consistency of representation,
2208 -- and the lack of a rule in RM95 was an oversight.
2215 -- Size information is copied from the full view to the
2216 -- incomplete or private view for consistency
2218 -- We skip this is the full view is not a type. This is
2219 -- very strange of course, and can only happen as a result
2220 -- of certain illegalities, such as a premature attempt to
2221 -- derive from an incomplete type.
2230 -- Case of no full view present. If entity is derived or subtype,
2231 -- it is safe to freeze, correctness depends on the frozen status
2232 -- of parent. Otherwise it is either premature usage, or a Taft
2233 -- amendment type, so diagnosis is at the point of use and the
2234 -- type might be frozen later.
2238 then
2241 else
2246 -- For access subprogram, freeze types of all formals, the return
2247 -- type was already frozen, since it is the Etype of the function.
2256 -- If the return type requires a transient scope, and we are on
2257 -- a target allowing functions to return with a depressed stack
2258 -- pointer, then we mark the function as requiring this treatment.
2260 if Functions_Return_By_DSP_On_Target
2262 then
2268 -- For access to a protected subprogram, freeze the equivalent
2269 -- type (however this is not set if we are not generating code)
2270 -- or if this is an anonymous type used just for resolution).
2275 then
2279 -- Generic types are never seen by the back-end, and are also not
2280 -- processed by the expander (since the expander is turned off for
2281 -- generic processing), so we never need freeze nodes for them.
2287 -- Some special processing for non-generic types to complete
2288 -- representation details not known till the freeze point.
2301 then
2305 -- If the current entity is an array or record subtype and has
2306 -- discriminants used to constrain it, it must not freeze, because
2307 -- Freeze_Entity nodes force Gigi to process the frozen type.
2313 declare
2318 begin
2326 then
2343 then
2344 declare
2348 begin
2356 then
2369 -- AI-117 requires that all new primitives of a tagged type
2370 -- must inherit the convention of the full view of the type.
2371 -- Inherited and overriding operations are defined to inherit
2372 -- the convention of their parent or overridden subprogram
2373 -- (also specified in AI-117), and that will have occurred
2374 -- earlier (in Derive_Subprogram and New_Overloaded_Entity).
2375 -- Here we set the convention of primitives that are still
2376 -- convention Ada, which will ensure that any new primitives
2377 -- inherit the type's convention. Class-wide types can have
2378 -- a foreign convention inherited from their specific type,
2379 -- but are excluded from this since they don't have any
2380 -- associated primitives.
2385 then
2386 declare
2390 begin
2403 -- Generate primitive operation references for a tagged type
2407 then
2408 declare
2413 begin
2418 -- If the operation is derived, get the original for
2419 -- cross-reference purposes (it is the original for
2420 -- which we want the xref, and for which the comes
2421 -- from source test needs to be performed).
2431 -- If we get an exception, then something peculiar has happened
2432 -- probably as a result of a previous error. Since this is only
2433 -- for non-critical cross-references, ignore the error.
2435 exception
2440 -- Now that all types from which E may depend are frozen, see
2441 -- if the size is known at compile time, if it must be unsigned,
2442 -- or if strict alignent is required
2451 -- Do not allow a size clause for a type which does not have a size
2452 -- that is known at compile time
2456 then
2457 -- Supress this message if errors posted on E, even if we are
2458 -- in all errors mode, since this is often a junk message
2461 Error_Msg_N
2467 -- Remaining process is to set/verify the representation information,
2468 -- in particular the size and alignment values. This processing is
2469 -- not required for generic types, since generic types do not play
2470 -- any part in code generation, and so the size and alignment values
2471 -- for suhc types are irrelevant.
2476 -- Otherwise we call the layout procedure
2478 else
2482 -- End of freeze processing for type entities
2485 -- Here is where we logically freeze the current entity. If it has a
2486 -- freeze node, then this is the point at which the freeze node is
2487 -- linked into the result list.
2491 -- If a freeze node is already allocated, use it, otherwise allocate
2492 -- a new one. The preallocation happens in the case of anonymous base
2493 -- types, where we preallocate so that we can set First_Subtype_Link.
2494 -- Note that we reset the Sloc to the current freeze location.
2500 else
2512 else
2518 -- When a type is frozen, the first subtype of the type is frozen as
2519 -- well (RM 13.14(15)). This has to be done after freezing the type,
2520 -- since obviously the first subtype depends on its own base type.
2525 -- If we just froze a tagged non-class wide record, then freeze the
2526 -- corresponding class-wide type. This must be done after the tagged
2527 -- type itself is frozen, because the class-wide type refers to the
2528 -- tagged type which generates the class.
2533 then
2540 -- Special handling for subprograms
2544 -- If subprogram has address clause then reset Is_Public flag, since
2545 -- we do not want the backend to generate external references.
2549 then
2552 -- If no address clause and not intrinsic, then for imported
2553 -- subprogram in main unit, generate descriptor if we are in
2554 -- Propagate_Exceptions mode.
2556 elsif Propagate_Exceptions
2560 then
2565 Generate_Subprogram_Descriptor_For_Imported_Subprogram
2574 -----------------------------
2575 -- Freeze_Enumeration_Type --
2576 -----------------------------
2579 begin
2583 then
2586 else
2591 -----------------------
2592 -- Freeze_Expression --
2593 -----------------------
2604 -- This flag is set true if the entity must be frozen outside the
2605 -- current subprogram. This happens in the case of expander generated
2606 -- subprograms (_Init_Proc, _Input, _Output, _Read, _Write) which do
2607 -- not freeze all entities like other bodies, but which nevertheless
2608 -- may reference entities that have to be frozen before the body and
2609 -- obviously cannot be frozen inside the body.
2612 -- Given an N_Handled_Sequence_Of_Statements node N, determines whether
2613 -- it is the handled statement sequence of an expander generated
2614 -- subprogram (init proc, or stream subprogram). If so, it returns
2615 -- True, otherwise False.
2620 begin
2623 else
2630 else
2639 then
2641 else
2648 -- Start of processing for Freeze_Expression
2650 begin
2651 -- Immediate return if freezing is inhibited. This flag is set by
2652 -- the analyzer to stop freezing on generated expressions that would
2653 -- cause freezing if they were in the source program, but which are
2654 -- not supposed to freeze, since they are created.
2660 -- If expression is non-static, then it does not freeze in a default
2661 -- expression, see section "Handling of Default Expressions" in the
2662 -- spec of package Sem for further details. Note that we have to
2663 -- make sure that we actually have a real expression (if we have
2664 -- a subtype indication, we can't test Is_Static_Expression!)
2666 if In_Def_Exp
2669 then
2673 -- Freeze type of expression if not frozen already
2677 then
2679 else
2683 -- For entity name, freeze entity if not frozen already. A special
2684 -- exception occurs for an identifier that did not come from source.
2685 -- We don't let such identifiers freeze a non-internal entity, i.e.
2686 -- an entity that did come from source, since such an identifier was
2687 -- generated by the expander, and cannot have any semantic effect on
2688 -- the freezing semantics. For example, this stops the parameter of
2689 -- an initialization procedure from freezing the variable.
2696 then
2699 else
2703 -- For an allocator freeze designated type if not frozen already.
2705 -- For an aggregate whose component type is an access type, freeze
2706 -- the designated type now, so that its freeze does not appear within
2707 -- the loop that might be created in the expansion of the aggregate.
2708 -- If the designated type is a private type without full view, the
2709 -- expression cannot contain an allocator, so the type is not frozen.
2720 then
2724 when N_Selected_Component |
2725 N_Indexed_Component |
2726 N_Slice =>
2740 then
2744 -- All done if nothing needs freezing
2749 then
2753 -- Loop for looking at the right place to insert the freeze nodes
2754 -- exiting from the loop when it is appropriate to insert the freeze
2755 -- node before the current node P.
2757 -- Also checks some special exceptions to the freezing rules. These
2758 -- cases result in a direct return, bypassing the freeze action.
2761 loop
2764 -- If we don't have a parent, then we are not in a well-formed
2765 -- tree. This is an unusual case, but there are some legitimate
2766 -- situations in which this occurs, notably when the expressions
2767 -- in the range of a type declaration are resolved. We simply
2768 -- ignore the freeze request in this case. Is this right ???
2774 -- See if we have got to an appropriate point in the tree
2778 -- A special test for the exception of (RM 13.14(8)) for the
2779 -- case of per-object expressions (RM 3.8(18)) occurring in a
2780 -- component definition or a discrete subtype definition. Note
2781 -- that we test for a component declaration which includes both
2782 -- cases we are interested in, and furthermore the tree does not
2783 -- have explicit nodes for either of these two constructs.
2787 -- The case we want to test for here is an identifier that is
2788 -- a per-object expression, this is either a discriminant that
2789 -- appears in a context other than the component declaration
2790 -- or it is a reference to the type of the enclosing construct.
2792 -- For either of these cases, we skip the freezing
2794 if not In_Default_Expression
2797 then
2798 -- We recognize the discriminant case by just looking for
2799 -- a reference to a discriminant. It can only be one for
2800 -- the enclosing construct. Skip freezing in this case.
2805 -- For the case of a reference to the enclosing record,
2806 -- (or task or protected type), we look for a type that
2807 -- matches the current scope.
2814 -- If we have an enumeration literal that appears as the
2815 -- choice in the aggregate of an enumeration representation
2816 -- clause, then freezing does not occur (RM 13.14(9)).
2820 -- The case we are looking for is an enumeration literal
2824 then
2825 -- If enumeration literal appears directly as the choice,
2826 -- do not freeze (this is the normal non-overloade case)
2830 then
2833 -- If enumeration literal appears as the name of a
2834 -- function which is the choice, then also do not freeze.
2835 -- This happens in the overloaded literal case, where the
2836 -- enumeration literal is temporarily changed to a function
2837 -- call for overloading analysis purposes.
2840 and then
2842 and then
2844 then
2849 -- Normally if the parent is a handled sequence of statements,
2850 -- then the current node must be a statement, and that is an
2851 -- appropriate place to insert a freeze node.
2855 -- An exception occurs when the sequence of statements is
2856 -- for an expander generated body that did not do the usual
2857 -- freeze all operation. In this case we usually want to
2858 -- freeze outside this body, not inside it, and we skip
2859 -- past the subprogram body that we are inside.
2863 -- However, we *do* want to freeze at this point if we have
2864 -- an entity to freeze, and that entity is declared *inside*
2865 -- the body of the expander generated procedure. This case
2866 -- is recognized by the scope of the type, which is either
2867 -- the spec for some enclosing body, or (in the case of
2868 -- init_procs, for which there are no separate specs) the
2869 -- current scope.
2871 declare
2875 begin
2880 or else
2882 then
2888 then
2894 -- If not that exception to the exception, then this is
2895 -- where we delay the freeze till outside the body.
2900 -- Here if normal case where we are in handled statement
2901 -- sequence and want to do the insertion right there.
2903 else
2907 -- If parent is a body or a spec or a block, then the current
2908 -- node is a statement or declaration and we can insert the
2909 -- freeze node before it.
2911 when N_Package_Specification |
2912 N_Package_Body |
2913 N_Subprogram_Body |
2914 N_Task_Body |
2915 N_Protected_Body |
2916 N_Entry_Body |
2919 -- The expander is allowed to define types in any statements list,
2920 -- so any of the following parent nodes also mark a freezing point
2921 -- if the actual node is in a list of statements or declarations.
2923 when N_Exception_Handler |
2924 N_If_Statement |
2925 N_Elsif_Part |
2926 N_Case_Statement_Alternative |
2927 N_Compilation_Unit_Aux |
2928 N_Selective_Accept |
2929 N_Accept_Alternative |
2930 N_Delay_Alternative |
2931 N_Conditional_Entry_Call |
2932 N_Entry_Call_Alternative |
2933 N_Triggering_Alternative |
2934 N_Abortable_Part |
2935 N_Freeze_Entity =>
2939 -- Note: The N_Loop_Statement is a special case. A type that
2940 -- appears in the source can never be frozen in a loop (this
2941 -- occurs only because of a loop expanded by the expander),
2942 -- so we keep on going. Otherwise we terminate the search.
2943 -- Same is true of any entity which comes from source. (if they
2944 -- have a predefined type, that type does not appear to come
2945 -- from source, but the entity should not be frozen here).
2951 -- For all other cases, keep looking at parents
2957 -- We fall through the case if we did not yet find the proper
2958 -- place in the free for inserting the freeze node, so climb!
2963 -- If the expression appears in a record or an initialization
2964 -- procedure, the freeze nodes are collected and attached to
2965 -- the current scope, to be inserted and analyzed on exit from
2966 -- the scope, to insure that generated entities appear in the
2967 -- correct scope. If the expression is a default for a discriminant
2968 -- specification, the scope is still void. The expression can also
2969 -- appear in the discriminant part of a private or concurrent type.
2971 -- The other case requiring this special handling is if we are in
2972 -- a default expression, since in that case we are about to freeze
2973 -- a static type, and the freeze scope needs to be the outer scope,
2974 -- not the scope of the subprogram with the default parameter.
2976 -- For default expressions in generic units, the Move_Freeze_Nodes
2977 -- mechanism (see sem_ch12.adb) takes care of placing them at the
2978 -- proper place, after the generic unit.
2981 or else Freeze_Outside
2986 then
2987 declare
2991 begin
3008 then
3009 Scope_Stack.Table
3011 Freeze_Nodes;
3012 else
3022 -- Now we have the right place to do the freezing. First, a special
3023 -- adjustment, if we are in default expression analysis mode, these
3024 -- freeze actions must not be thrown away (normally all inserted
3025 -- actions are thrown away in this mode. However, the freeze actions
3026 -- are from static expressions and one of the important reasons we
3027 -- are doing this special analysis is to get these freeze actions.
3028 -- Therefore we turn off the In_Default_Expression mode to propagate
3029 -- these freeze actions. This also means they get properly analyzed
3030 -- and expanded.
3034 -- Freeze the designated type of an allocator (RM 13.14(12))
3040 -- Freeze type of expression (RM 13.14(9)). Note that we took care of
3041 -- the enumeration representation clause exception in the loop above.
3047 -- Freeze name if one is present (RM 13.14(10))
3056 -----------------------------
3057 -- Freeze_Fixed_Point_Type --
3058 -----------------------------
3060 -- Certain fixed-point types and subtypes, including implicit base
3061 -- types and declared first subtypes, have not yet set up a range.
3062 -- This is because the range cannot be set until the Small and Size
3063 -- values are known, and these are not known till the type is frozen.
3065 -- To signal this case, Scalar_Range contains an unanalyzed syntactic
3066 -- range whose bounds are unanalyzed real literals. This routine will
3067 -- recognize this case, and transform this range node into a properly
3068 -- typed range with properly analyzed and resolved values.
3086 -- Returns size of type with given bounds. Also leaves these
3087 -- bounds set as the current bounds of the Typ.
3090 begin
3096 -- Start of processing for Freeze_Fixed_Point_Type;
3098 begin
3099 -- If Esize of a subtype has not previously been set, set it now
3106 else
3111 -- Immediate return if the range is already analyzed. This means
3112 -- that the range is already set, and does not need to be computed
3113 -- by this routine.
3119 -- Immediate return if either of the bounds raises Constraint_Error
3123 then
3130 -- Ordinary fixed-point case
3134 -- For the ordinary fixed-point case, we are allowed to fudge the
3135 -- end-points up or down by small. Generally we prefer to fudge
3136 -- up, i.e. widen the bounds for non-model numbers so that the
3137 -- end points are included. However there are cases in which this
3138 -- cannot be done, and indeed cases in which we may need to narrow
3139 -- the bounds. The following circuit makes the decision.
3141 -- Note: our terminology here is that Incl_EP means that the
3142 -- bounds are widened by Small if necessary to include the end
3143 -- points, and Excl_EP means that the bounds are narrowed by
3144 -- Small to exclude the end-points if this reduces the size.
3146 -- Note that in the Incl case, all we care about is including the
3147 -- end-points. In the Excl case, we want to narrow the bounds as
3148 -- much as permitted by the RM, to give the smallest possible size.
3165 begin
3166 -- First step. Base types are required to be symmetrical. Right
3167 -- now, the base type range is a copy of the first subtype range.
3168 -- This will be corrected before we are done, but right away we
3169 -- need to deal with the case where both bounds are non-negative.
3170 -- In this case, we set the low bound to the negative of the high
3171 -- bound, to make sure that the size is computed to include the
3172 -- required sign. Note that we do not need to worry about the
3173 -- case of both bounds negative, because the sign will be dealt
3174 -- with anyway. Furthermore we can't just go making such a bound
3175 -- symmetrical, since in a twos-complement system, there is an
3176 -- extra negative value which could not be accomodated on the
3177 -- positive side.
3182 then
3187 -- Compute the fudged bounds. If the number is a model number,
3188 -- then we do nothing to include it, but we are allowed to
3189 -- backoff to the next adjacent model number when we exclude
3190 -- it. If it is not a model number then we straddle the two
3191 -- values with the model numbers on either side.
3197 else
3201 -- The low value excluding the end point is Small greater, but
3202 -- we do not do this exclusion if the low value is positive,
3203 -- since it can't help the size and could actually hurt by
3204 -- crossing the high bound.
3208 else
3212 -- Similar processing for upper bound and high value
3218 else
3224 else
3228 -- One further adjustment is needed. In the case of subtypes,
3229 -- we cannot go outside the range of the base type, or we get
3230 -- peculiarities, and the base type range is already set. This
3231 -- only applies to the Incl values, since clearly the Excl
3232 -- values are already as restricted as they are allowed to be.
3239 -- Get size including and excluding end points
3244 -- No need to exclude end-points if it does not reduce size
3254 -- Now we set the actual size to be used. We want to use the
3255 -- bounds fudged up to include the end-points but only if this
3256 -- can be done without violating a specifically given size
3257 -- size clause or causing an unacceptable increase in size.
3259 -- Case of size clause given
3263 -- Use the inclusive size only if it is consistent with
3264 -- the explicitly specified size.
3271 -- If the inclusive size is too large, we try excluding
3272 -- the end-points (will be caught later if does not work).
3274 else
3280 -- Case of size clause not given
3282 else
3283 -- If we have a base type whose corresponding first subtype
3284 -- has an explicit size that is large enough to include our
3285 -- end-points, then do so. There is no point in working hard
3286 -- to get a base type whose size is smaller than the specified
3287 -- size of the first subtype.
3293 then
3298 -- If excluding the end-points makes the size smaller and
3299 -- results in a size of 8,16,32,64, then we take the smaller
3300 -- size. For the 64 case, this is compulsory. For the other
3301 -- cases, it seems reasonable. We like to include end points
3302 -- if we can, but not at the expense of moving to the next
3303 -- natural boundary of size.
3306 and then
3311 then
3316 -- Otherwise we can definitely include the end points
3318 else
3324 -- One pathological case: normally we never fudge a low
3325 -- bound down, since it would seem to increase the size
3326 -- (if it has any effect), but for ranges containing a
3327 -- single value, or no values, the high bound can be
3328 -- small too large. Consider:
3330 -- type t is delta 2.0**(-14)
3331 -- range 131072.0 .. 0;
3333 -- That lower bound is *just* outside the range of 32
3334 -- bits, and does need fudging down in this case. Note
3335 -- that the bounds will always have crossed here, since
3336 -- the high bound will be fudged down if necessary, as
3337 -- in the case of:
3339 -- type t is delta 2.0**(-14)
3340 -- range 131072.0 .. 131072.0;
3342 -- So we can detect the situation by looking for crossed
3343 -- bounds, and if the bounds are crossed, and the low
3344 -- bound is greater than zero, we will always back it
3345 -- off by small, since this is completely harmless.
3352 -- And of course, we need to do exactly the same parallel
3353 -- fudge for flat ranges in the negative region.
3366 -- For the decimal case, none of this fudging is required, since there
3367 -- are no end-point problems in the decimal case (the end-points are
3368 -- always included).
3370 else
3374 -- At this stage, the actual size has been calculated and the proper
3375 -- required bounds are stored in the low and high bounds.
3379 Error_Msg_N
3384 -- Check size against explicit given size
3390 Error_Msg_NE
3394 else
3398 -- Increase size to next natural boundary if no size clause given
3400 else
3407 else
3415 -- If we have a base type, then expand the bounds so that they
3416 -- extend to the full width of the allocated size in bits, to
3417 -- avoid junk range checks on intermediate computations.
3424 -- Final step is to reanalyze the bounds using the proper type
3425 -- and set the Corresponding_Integer_Value fields of the literals.
3431 -- Resolve with universal fixed if the base type, and the base
3432 -- type if it is a subtype. Note we can't resolve the base type
3433 -- with itself, that would be a reference before definition.
3437 else
3441 -- Set corresponding integer value for bound
3443 Set_Corresponding_Integer_Value
3446 -- Similar processing for high bound
3454 else
3458 Set_Corresponding_Integer_Value
3461 -- Set type of range to correspond to bounds
3465 -- Set Esize to calculated size and also set RM_Size
3469 -- Set RM_Size if not already set. If already set, check value
3471 declare
3474 begin
3479 Error_Msg_NE
3484 else
3491 ------------------
3492 -- Freeze_Itype --
3493 ------------------
3498 begin
3507 --------------------------
3508 -- Freeze_Static_Object --
3509 --------------------------
3514 -- Exception raised if the type of a static object cannot be made
3515 -- static. This happens if the type depends on non-global objects.
3518 -- Called to ensure that an expression used as part of a type
3519 -- definition is statically allocatable, which means that the type
3520 -- of the expression is statically allocatable, and the expression
3521 -- is either static, or a reference to a library level constant.
3524 -- Called to mark a type as static, checking that it is possible
3525 -- to set the type as static. If it is not possible, then the
3526 -- exception Cannot_Be_Static is raised.
3528 -----------------------------
3529 -- Ensure_Expression_Is_SA --
3530 -----------------------------
3535 begin
3547 then
3555 -----------------------
3556 -- Ensure_Type_Is_SA --
3557 -----------------------
3563 begin
3564 -- If type is library level, we are all set
3570 -- We are also OK if the type is already marked as statically
3571 -- allocated, which means we processed it before.
3577 -- Mark type as statically allocated
3581 -- Check that it is safe to statically allocate this type
3599 declare
3603 begin
3616 else
3626 then
3645 else
3650 -- Start of processing for Freeze_Static_Object
3652 begin
3655 exception
3658 -- If the object that cannot be static is imported or exported,
3659 -- then we give an error message saying that this object cannot
3660 -- be imported or exported.
3663 Error_Msg_N
3666 -- Otherwise must be exported, something is wrong if compiler
3667 -- is marking something as statically allocated which cannot be).
3670 Error_Msg_N
3675 -----------------------
3676 -- Freeze_Subprogram --
3677 -----------------------
3683 begin
3684 -- Subprogram may not have an address clause unless it is imported
3688 Error_Msg_N
3695 -- For non-foreign convention subprograms, this is where we create
3696 -- the extra formals (for accessibility level and constrained bit
3697 -- information). We delay this till the freeze point precisely so
3698 -- that we know the convention!
3704 -- If this is convention Ada and a Valued_Procedure, that's odd
3709 then
3710 Error_Msg_N
3715 -- Case of foreign convention
3717 else
3720 -- For foreign conventions, do not permit return of an
3721 -- unconstrained array.
3723 -- Note: we *do* allow a return by descriptor for the VMS case,
3724 -- though here there is probably more to be done ???
3729 -- If no return type, probably some other error, e.g. a
3730 -- missing full declaration, so ignore.
3735 -- If the return type is generic, we have emitted a warning
3736 -- earlier on, and there is nothing else to check here.
3737 -- Specific instantiations may lead to erroneous behavior.
3745 then
3746 Error_Msg_NE
3753 -- If any of the formals for an exported foreign convention
3754 -- subprogram have defaults, then emit an appropriate warning
3755 -- since this is odd (default cannot be used from non-Ada code)
3761 Error_Msg_N
3771 -- For VMS, descriptor mechanisms for parameters are allowed only
3772 -- for imported subprograms.
3779 Error_Msg_N
3781 Error_Msg_N
3792 -----------------------
3793 -- Is_Fully_Defined --
3794 -----------------------
3796 -- Should this be in Sem_Util ???
3799 begin
3802 else
3808 ---------------------------------
3809 -- Process_Default_Expressions --
3810 ---------------------------------
3812 procedure Process_Default_Expressions
3815 is
3822 begin
3825 -- A subprogram instance and its associated anonymous subprogram
3826 -- share their signature. The default expression functions are defined
3827 -- in the wrapper packages for the anonymous subprogram, and should
3828 -- not be generated again for the instance.
3833 then
3842 -- We work with a copy of the default expression because we
3843 -- do not want to disturb the original, since this would mess
3844 -- up the conformance checking.
3848 -- The analysis of the expression may generate insert actions,
3849 -- which of course must not be executed. We wrap those actions
3850 -- in a procedure that is not called, and later on eliminated.
3851 -- The following cases have no side-effects, and are analyzed
3852 -- directly.
3863 and then
3866 then
3868 -- If there is no default function, we must still do a full
3869 -- analyze call on the default value, to ensure that all
3870 -- error checks are performed, e.g. those associated with
3871 -- static evaluation. Note that this branch will always be
3872 -- taken if the analyzer is turned off (but we still need the
3873 -- error checks).
3875 -- Note: the setting of parent here is to meet the requirement
3876 -- that we can only analyze the expression while attached to
3877 -- the tree. Really the requirement is that the parent chain
3878 -- be set, we don't actually need to be in the tree.
3883 -- Default expressions are resolved with their own type if the
3884 -- context is generic, to avoid anomalies with private types.
3888 else
3892 -- If that resolved expression will raise constraint error,
3893 -- then flag the default value as raising constraint error.
3894 -- This allows a proper error message on the calls.
3900 -- If the default is a parameterless call, we use the name of
3901 -- the called function directly, and there is no body to build.
3905 then
3908 -- Else construct and analyze the body of a wrapper procedure
3909 -- that contains an object declaration to hold the expression.
3910 -- Given that this is done only to complete the analysis, it
3911 -- simpler to build a procedure than a function which might
3912 -- involve secondary stack expansion.
3914 else
3915 Dnam :=
3918 Dbody :=
3920 Specification =>
3926 Defining_Identifier =>
3929 Object_Definition =>
3933 Handled_Statement_Sequence =>
3951 ----------------------------------------
3952 -- Set_Component_Alignment_If_Not_Set --
3953 ----------------------------------------
3956 begin
3957 -- Ignore if not base type, subtypes don't need anything
3963 -- Do not override existing representation
3974 else
3975 Set_Component_Alignment
3981 ---------------------------
3982 -- Set_Debug_Info_Needed --
3983 ---------------------------
3986 begin
3990 then
3992 else
4003 declare
4005 begin
4015 declare
4017 begin