| blob | e1855b73e9baba62ed979ed09e1ca3e0046e07a6 |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- F R E E Z E --
6 -- --
7 -- B o d y --
8 -- --
9 -- $Revision: 1.2 $
10 -- --
11 -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
12 -- --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
23 -- --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 -- --
27 ------------------------------------------------------------------------------
65 -----------------------
66 -- Local Subprograms --
67 -----------------------
70 -- Typ is a type that is being frozen. If no size clause is given,
71 -- but a default Esize has been computed, then this default Esize is
72 -- adjusted up if necessary to be consistent with a given alignment,
73 -- but never to a value greater than Long_Long_Integer'Size. This
74 -- is used for all discrete types and for fixed-point types.
76 procedure Build_And_Analyze_Renamed_Body
80 -- Build body for a renaming declaration, insert in tree and analyze.
83 -- E is a base type. If E is tagged or has a component that is aliased
84 -- or tagged or contains something this is aliased or tagged, set
85 -- Strict_Alignment.
89 -- If E is a fixed-point or discrete type, then all the necessary work
90 -- to freeze it is completed except for possible setting of the flag
91 -- Is_Unsigned_Type, which is done by this procedure. The call has no
92 -- effect if the entity E is not a discrete or fixed-point type.
94 procedure Freeze_And_Append
98 -- Freezes Ent using Freeze_Entity, and appends the resulting list of
99 -- nodes to Result, modifying Result from No_List if necessary.
102 -- Freeze enumeration type. The Esize field is set as processing
103 -- proceeds (i.e. set by default when the type is declared and then
104 -- adjusted by rep clauses. What this procedure does is to make sure
105 -- that if a foreign convention is specified, and no specific size
106 -- is given, then the size must be at least Integer'Size.
109 -- If an object is frozen which has Is_Statically_Allocated set, then
110 -- all referenced types must also be marked with this flag. This routine
111 -- is in charge of meeting this requirement for the object entity E.
114 -- Perform freezing actions for a subprogram (create extra formals,
115 -- and set proper default mechanism values). Note that this routine
116 -- is not called for internal subprograms, for which neither of these
117 -- actions is needed (or desirable, we do not want for example to have
118 -- these extra formals present in initialization procedures, where they
119 -- would serve no purpose). In this call E is either a subprogram or
120 -- a subprogram type (i.e. an access to a subprogram).
123 -- true if T is not private, or has a full view.
125 procedure Process_Default_Expressions
128 -- This procedure is called for each subprogram to complete processing
129 -- of default expressions at the point where all types are known to be
130 -- frozen. The expressions must be analyzed in full, to make sure that
131 -- all error processing is done (they have only been pre-analyzed). If
132 -- the expression is not an entity or literal, its analysis may generate
133 -- code which must not be executed. In that case we build a function
134 -- body to hold that code. This wrapper function serves no other purpose
135 -- (it used to be called to evaluate the default, but now the default is
136 -- inlined at each point of call).
139 -- Typ is a record or array type that is being frozen. This routine
140 -- sets the default component alignment from the scope stack values
141 -- if the alignment is otherwise not specified.
144 -- As each entity is frozen, this routine is called to deal with the
145 -- setting of Debug_Info_Needed for the entity. This flag is set if
146 -- the entity comes from source, or if we are in Debug_Generated_Code
147 -- mode or if the -gnatdV debug flag is set. However, it never sets
148 -- the flag if Debug_Info_Off is set.
151 -- Sets the Debug_Info_Needed flag on entity T if not already set, and
152 -- also on any entities that are needed by T (for an object, the type
153 -- of the object is needed, and for a type, the subsidiary types are
154 -- needed -- see body for details). Never has any effect on T if the
155 -- Debug_Info_Off flag is set.
157 -------------------------------
158 -- Adjust_Esize_For_Alignment --
159 -------------------------------
164 begin
170 then
176 ------------------------------------
177 -- Build_And_Analyze_Renamed_Body --
178 ------------------------------------
180 procedure Build_And_Analyze_Renamed_Body
184 is
187 begin
194 ------------------------
195 -- Build_Renamed_Body --
196 ------------------------
198 function Build_Renamed_Body
201 return Node_Id
202 is
204 -- We use for the source location of the renamed body, the location
205 -- of the spec entity. It might seem more natural to use the location
206 -- of the renaming declaration itself, but that would be wrong, since
207 -- then the body we create would look as though it was created far
208 -- too late, and this could cause problems with elaboration order
209 -- analysis, particularly in connection with instantiations.
223 begin
224 -- Determine the entity being renamed, which is the target of the
225 -- call statement. If the name is an explicit dereference, this is
226 -- a renaming of a subprogram type rather than a subprogram. The
227 -- name itself is fully analyzed.
239 else
246 else
252 else
255 -- The original name may have been overloaded, but
256 -- is fully resolved now.
261 -- For simple renamings, subsequent calls can be expanded directly
262 -- as called to the renamed entity. The body must be generated in
263 -- any case for calls they may appear elsewhere.
268 then
272 -- The body generated for this renaming is an internal artifact, and
273 -- does not constitute a freeze point for the called entity.
288 -- If the renamed entity is an entry, inherit its profile. For
289 -- other renamings as bodies, both profiles must be subtype
290 -- conformant, so it is not necessary to replace the profile given
291 -- in the declaration. However, default values that are aggregates
292 -- are rewritten when partially analyzed, so we recover the original
293 -- aggregate to insure that subsequent conformity checking works.
305 N_Access_Definition
306 then
322 -- If the renamed entity is a function, the generated body contains a
323 -- return statement. Otherwise, build a procedure call. If the entity is
324 -- an entry, subsequent analysis of the call will transform it into the
325 -- proper entry or protected operation call. If the renamed entity is
326 -- a character literal, return it directly.
332 then
333 Call_Node :=
335 Expression =>
341 Call_Node :=
346 Call_Node :=
350 else
351 Call_Node :=
357 -- Create entities for subprogram body and formals.
371 Body_Node :=
375 Handled_Statement_Sequence =>
385 -- Link the body to the entity whose declaration it completes. If
386 -- the body is analyzed when the renamed entity is frozen, it may be
387 -- necessary to restore the proper scope (see package Exp_Ch13).
391 then
393 else
400 -----------------------------
401 -- Check_Compile_Time_Size --
402 -----------------------------
407 -- Sets the compile time known size (32 bits or less) in the Esize
408 -- field, checking for a size clause that was given which attempts
409 -- to give a smaller size.
412 -- Recursive function that does all the work.
413 -- Is this right??? isn't recursive case already handled???
414 -- certainly yes for normal call, but what about bogus sem_res call???
417 -- If T is a constrained subtype, its size is not known if any of its
418 -- discriminant constraints is not static and it is not a null record.
419 -- The test is conservative and doesn't check that the components are
420 -- in fact constrained by non-static discriminant values. Could be made
421 -- more precise ???
423 --------------------
424 -- Set_Small_Size --
425 --------------------
428 begin
435 Error_Msg_NE
443 -- Set sizes if not set already
445 else
456 ----------------
457 -- Size_Known --
458 ----------------
467 begin
476 then
492 -- Check for all indexes static, and also compute possible
493 -- size (in case it is less than 32 and may be packable).
495 declare
499 begin
509 else
517 then
520 else
525 else
543 then
554 else
555 declare
559 begin
560 -- Test for variant part present
566 N_Record_Definition
570 then
571 -- If variant part is present, and type is unconstrained,
572 -- then we must have defaulted discriminants, or a size
573 -- clause must be present for the type, or else the size
574 -- is definitely not known at compile time.
577 and then
578 No (Discriminant_Default_Value
581 then
583 else
584 -- We do not know the packed size, it is too much
585 -- trouble to figure it out.
595 or else
597 then
609 -- If RM_Size is known and static, then we can
610 -- keep accumulating the packed size.
614 -- A little glitch, to be removed sometime ???
615 -- gigi does not understand zero sizes yet.
621 Packed_Size :=
624 -- If we have a field whose RM_Size is not known
625 -- then we can't figure out the packed size here.
627 else
644 else
649 -------------------------------------
650 -- Static_Discriminated_Components --
651 -------------------------------------
653 function Static_Discriminated_Components
656 is
659 begin
663 then
678 -- Start of processing for Check_Compile_Time_Size
680 begin
684 -----------------------------
685 -- Check_Debug_Info_Needed --
686 -----------------------------
689 begin
694 or else Debug_Generated_Code
695 or else Debug_Flag_VV
696 then
701 ----------------------------
702 -- Check_Strict_Alignment --
703 ----------------------------
708 begin
727 then
737 -------------------------
738 -- Check_Unsigned_Type --
739 -------------------------
746 begin
751 -- Do not attempt to analyze case where range was in error
757 -- The situation that is non trivial is something like
759 -- subtype x1 is integer range -10 .. +10;
760 -- subtype x2 is x1 range 0 .. V1;
761 -- subtype x3 is x2 range V2 .. V3;
762 -- subtype x4 is x3 range V4 .. V5;
764 -- where Vn are variables. Here the base type is signed, but we still
765 -- know that x4 is unsigned because of the lower bound of x2.
767 -- The only way to deal with this is to look up the ancestor chain
770 loop
785 else
788 -- If no ancestor had a static lower bound, go to base type
792 -- Note: the reason we still check for a compile time known
793 -- value for the base type is that at least in the case of
794 -- generic formals, we can have bounds that fail this test,
795 -- and there may be other cases in error situations.
807 then
818 ----------------
819 -- Freeze_All --
820 ----------------
822 -- Note: the easy coding for this procedure would be to just build a
823 -- single list of freeze nodes and then insert them and analyze them
824 -- all at once. This won't work, because the analysis of earlier freeze
825 -- nodes may recursively freeze types which would otherwise appear later
826 -- on in the freeze list. So we must analyze and expand the freeze nodes
827 -- as they are generated.
835 -- This is the internal recursive routine that does freezing of
836 -- entities (but NOT the analysis of default expressions, which
837 -- should not be recursive, we don't want to analyze those till
838 -- we are sure that ALL the types are frozen).
840 procedure Freeze_All_Ent
843 is
849 -- If freeze nodes are present, insert and analyze, and reset
850 -- cursor for next insertion.
853 begin
860 else
866 begin
870 -- If the entity is an inner package which is not a package
871 -- renaming, then its entities must be frozen at this point.
872 -- Note that such entities do NOT get frozen at the end of
873 -- the nested package itself (only library packages freeze).
875 -- Same is true for task declarations, where anonymous records
876 -- created for entry parameters must be frozen.
882 then
892 and then
894 or else
896 then
899 End_Scope;
901 -- For a derived tagged type, we must ensure that all the
902 -- primitive operations of the parent have been frozen, so
903 -- that their addresses will be in the parent's dispatch table
904 -- at the point it is inherited.
910 then
911 declare
917 begin
925 then
927 Process_Flist;
937 Process_Flist;
944 -- Start of processing for Freeze_All
946 begin
949 -- Now that all types are frozen, we can deal with default expressions
950 -- that require us to build a default expression functions. This is the
951 -- point at which such functions are constructed (after all types that
952 -- might be used in such expressions have been frozen).
953 -- We also add finalization chains to access types whose designated
954 -- types are controlled. This is normally done when freezing the type,
955 -- but this misses recursive type definitions where the later members
956 -- of the recursion introduce controlled components (e.g. 5624-001).
958 -- Loop through entities
977 and then
979 = N_Subprogram_Renaming_Declaration
980 then
981 Build_And_Analyze_Renamed_Body
987 and then
989 or else
991 then
992 declare
995 begin
1002 then
1015 then
1024 -----------------------
1025 -- Freeze_And_Append --
1026 -----------------------
1028 procedure Freeze_And_Append
1032 is
1035 begin
1039 else
1045 -------------------
1046 -- Freeze_Before --
1047 -------------------
1053 begin
1063 -------------------
1064 -- Freeze_Entity --
1065 -------------------
1076 -- Check that an Access or Unchecked_Access attribute with
1077 -- a prefix which is the current instance type can only be
1078 -- applied when the type is limited.
1081 -- If Loc is a freeze_entity that appears after the last declaration
1082 -- in the scope, inhibit error messages on late completion.
1085 -- Freeze each component, handle some representation clauses, and
1086 -- freeze primitive operations if this is a tagged type.
1088 ----------------------------
1089 -- After_Last_Declaration --
1090 ----------------------------
1095 begin
1102 else
1106 else
1111 ----------------------------
1112 -- Check_Current_Instance --
1113 ----------------------------
1118 -- Process routine to apply check to given node.
1121 begin
1125 or else
1130 then
1131 Error_Msg_N
1134 else
1144 -- Start of processing for Check_Current_Instance
1146 begin
1150 ------------------------
1151 -- Freeze_Record_Type --
1152 ------------------------
1160 -- Set True if we find at least one component with no component
1161 -- clause (used to warn about useless Pack pragmas).
1164 -- Set True if we find at least one component with a component
1165 -- clause (used to warn about useless Bit_Order pragmas).
1167 begin
1168 -- Freeze components and embedded subtypes
1178 -- If the component is an access type with an allocator
1179 -- as default value, the designated type will be frozen
1180 -- by the corresponding expression in init_proc. In order
1181 -- to place the freeze node for the designated type before
1182 -- that for the current record type, freeze it now.
1184 -- Same process if the component is an array of access types,
1185 -- initialized with an aggregate. If the designated type is
1186 -- private, it cannot contain allocators, and it is premature
1187 -- to freeze the type, so we check for this as well.
1193 then
1194 declare
1197 begin
1198 -- If component is pointer to a classwide type, freeze
1199 -- the specific type in the expression being allocated.
1200 -- The expression may be a subtype indication, in which
1201 -- case freeze the subtype mark.
1206 Freeze_And_Append
1208 elsif
1210 then
1211 Freeze_And_Append
1215 else
1216 Freeze_And_Append
1227 and then Is_Fully_Defined
1229 then
1230 Freeze_And_Append
1231 (Designated_Type
1235 -- Processing for real components (exclude anonymous subtypes)
1239 then
1240 -- Check for error of component clause given for variable
1241 -- sized type. We have to delay this test till this point,
1242 -- since the component type has to be frozen for us to know
1243 -- if it is variable length. We omit this test in a generic
1244 -- context, it will be applied at instantiation time.
1246 declare
1249 begin
1253 if not Size_Known_At_Compile_Time
1255 and then not Inside_A_Generic
1256 then
1257 Error_Msg_N
1262 else
1267 -- If component clause is present, then deal with the
1268 -- non-default bit order case. We cannot do this before
1269 -- the freeze point, because there is no required order
1270 -- for the component clause and the bit_order clause.
1272 -- We only do this processing for the base type, and in
1273 -- fact that's important, since otherwise if there are
1274 -- record subtypes, we could reverse the bits once for
1275 -- each subtype, which would be incorrect.
1280 then
1281 declare
1294 begin
1295 -- Cases where field goes over storage unit boundary
1299 -- Allow multi-byte field but generate warning
1303 then
1304 Error_Msg_N
1309 Error_Msg_N
1312 else
1313 Error_Msg_N
1318 -- Do not allow non-contiguous field
1320 else
1321 Error_Msg_N
1324 Error_Msg_N
1329 -- Case where field fits in one storage unit
1331 else
1332 -- Give warning if suspicious component clause
1335 Error_Msg_N
1338 Error_Msg_Uint_1 :=
1340 Error_Msg_N
1345 -- Here is where we fix up the Component_Bit_Offset
1346 -- value to account for the reverse bit order.
1347 -- Some examples of what needs to be done are:
1349 -- First_Bit .. Last_Bit Component_Bit_Offset
1350 -- old new old new
1352 -- 0 .. 0 7 .. 7 0 7
1353 -- 0 .. 1 6 .. 7 0 6
1354 -- 0 .. 2 5 .. 7 0 5
1355 -- 0 .. 7 0 .. 7 0 4
1357 -- 1 .. 1 6 .. 6 1 6
1358 -- 1 .. 4 3 .. 6 1 3
1359 -- 4 .. 7 0 .. 3 4 0
1361 -- The general rule is that the first bit is
1362 -- is obtained by subtracting the old ending bit
1363 -- from storage_unit - 1.
1380 -- Check for useless pragma Bit_Order
1388 -- Check for useless pragma Pack when all components placed
1391 and then not Unplaced_Component
1392 and then Warn_On_Redundant_Constructs
1393 then
1394 Error_Msg_N
1400 -- If this is the record corresponding to a remote type,
1401 -- freeze the remote type here since that is what we are
1402 -- semantically freeing. This prevents having the freeze node
1403 -- for that type in an inner scope.
1405 -- Also, Check for controlled components and unchecked unions.
1406 -- Finally, enforce the restriction that access attributes with
1407 -- a current instance prefix can only apply to limited types.
1412 Freeze_And_Append
1423 and then Present
1425 and then Has_Controlled_Component
1427 then
1438 then
1439 -- Scan component declaration for likely misuses of
1440 -- current instance, either in a constraint or in a
1441 -- default expression.
1452 -- For first subtypes, check if there are any fixed-point
1453 -- fields with component clauses, where we must check the size.
1454 -- This is not done till the freeze point, since for fixed-point
1455 -- types, we do not know the size until the type is frozen.
1463 then
1464 Check_Size
1468 Junk);
1476 -- Start of processing for Freeze_Entity
1478 begin
1479 -- Do not freeze if already frozen since we only need one freeze node.
1484 -- It is improper to freeze an external entity within a generic
1485 -- because its freeze node will appear in a non-valid context.
1486 -- ??? We should probably freeze the entity at that point and insert
1487 -- the freeze node in a proper place but this proper place is not
1488 -- easy to find, and the proper scope is not easy to restore. For
1489 -- now, just wait to get out of the generic to freeze ???
1494 -- Do not freeze a global entity within an inner scope created during
1495 -- expansion. A call to subprogram E within some internal procedure
1496 -- (a stream attribute for example) might require freezing E, but the
1497 -- freeze node must appear in the same declarative part as E itself.
1498 -- The two-pass elaboration mechanism in gigi guarantees that E will
1499 -- be frozen before the inner call is elaborated. We exclude constants
1500 -- from this test, because deferred constants may be frozen early, and
1501 -- must be diagnosed (see e.g. 1522-005). If the enclosing subprogram
1502 -- comes from source, or is a generic instance, then the freeze point
1503 -- is the one mandated by the language. and we freze the entity.
1508 then
1509 declare
1512 begin
1517 then
1519 else
1529 -- Here to freeze the entity
1534 -- Case of entity being frozen is other than a type
1538 -- If entity is exported or imported and does not have an external
1539 -- name, now is the time to provide the appropriate default name.
1540 -- Skip this if the entity is stubbed, since we don't need a name
1541 -- for any stubbed routine.
1546 then
1547 Set_Encoded_Interface_Name
1551 -- For a subprogram, freeze all parameter types and also the return
1552 -- type (RM 13.14(13)). However skip this for internal subprograms.
1553 -- This is also the point where any extra formal parameters are
1554 -- created since we now know whether the subprogram will use
1555 -- a foreign convention.
1561 declare
1565 -- Determines if given type entity is a fat pointer type
1566 -- used as an argument type or return type to a subprogram
1567 -- with C or C++ convention set.
1569 --------------------------
1570 -- Is_Fat_C_Access_Type --
1571 --------------------------
1574 begin
1576 or else
1582 begin
1583 -- Loop through formals
1597 then
1598 -- If the type of a formal is incomplete, subprogram
1599 -- is being frozen prematurely. Within an instance
1600 -- (but not within a wrapper package) this is an
1601 -- an artifact of our need to regard the end of an
1602 -- instantiation as a freeze point. Otherwise it is
1603 -- a definite error.
1604 -- and then not Is_Wrapper_Package (Current_Scope) ???
1612 Error_Msg
1614 Loc);
1618 -- Check bad use of fat C pointer
1622 Error_Msg_N
1624 Formal);
1628 -- Check for unconstrained array in exported foreign
1629 -- convention case.
1635 then
1637 Error_Msg_N
1639 Formal);
1640 Error_Msg_N
1642 Formal);
1649 -- Check return type
1655 Error_Msg_N
1657 E);
1663 then
1664 Error_Msg_N
1672 -- Must freeze its parent first if it is a derived subprogram
1678 -- If the return type requires a transient scope, and we are on
1679 -- a target allowing functions to return with a depressed stack
1680 -- pointer, then we mark the function as requiring this treatment.
1683 and then Functions_Return_By_DSP_On_Target
1685 then
1693 -- Here for other than a subprogram or type
1695 else
1696 -- If entity has a type, and it is not a generic unit, then
1697 -- freeze it first (RM 13.14(10))
1701 then
1705 -- For object created by object declaration, perform required
1706 -- categorization (preelaborate and pure) checks. Defer these
1707 -- checks to freeze time since pragma Import inhibits default
1708 -- initialization and thus pragma Import affects these checks.
1714 -- Check that a constant which has a pragma Volatile[_Components]
1715 -- or Atomic[_Components] also has a pragma Import (RM C.6(13))
1717 -- Note: Atomic[_Components] also sets Volatile[_Components]
1722 then
1723 -- Make sure we actually have a pragma, and have not merely
1724 -- inherited the indication from elsewhere (e.g. an address
1725 -- clause, which is not good enough in RM terms!)
1731 then
1732 Error_Msg_N
1734 E);
1738 -- Static objects require special handling
1742 then
1746 -- Remaining step is to layout objects
1749 or else
1751 or else
1753 or else
1755 then
1760 -- Case of a type or subtype being frozen
1762 else
1763 -- The type may be defined in a generic unit. This can occur when
1764 -- freezing a generic function that returns the type (which is
1765 -- defined in a parent unit). It is clearly meaningless to freeze
1766 -- this type. However, if it is a subtype, its size may be determi-
1767 -- nable and used in subsequent checks, so might as well try to
1768 -- compute it.
1772 then
1777 -- Deal with special cases of freezing for subtype
1781 -- If ancestor subtype present, freeze that first.
1782 -- Note that this will also get the base type frozen.
1789 -- Otherwise freeze the base type of the entity before
1790 -- freezing the entity itself, (RM 13.14(14)).
1796 -- For a derived type, freeze its parent type first (RM 13.14(14))
1803 -- For array type, freeze index types and component type first
1804 -- before freezing the array (RM 13.14(14)).
1807 declare
1811 -- Set true if any of the index types is an enumeration
1812 -- type with a non-standard representation.
1814 begin
1823 then
1830 -- For base type, propagate flags for component type
1835 then
1844 -- If packing was requested or if the component size was set
1845 -- explicitly, then see if bit packing is required. This
1846 -- processing is only done for base types, since all the
1847 -- representation aspects involved are type-related. This
1848 -- is not just an optimization, if we start processing the
1849 -- subtypes, they intefere with the settings on the base
1850 -- type (this is because Is_Packed has a slightly different
1851 -- meaning before and after freezing).
1854 declare
1858 begin
1862 then
1871 else
1874 -- We can set the component size if it is less than
1875 -- 16, rounding it up to the next storage unit size.
1881 else
1885 -- Set component size up to match alignment if
1886 -- it would otherwise be less than the alignment.
1887 -- This deals with cases of types whose alignment
1888 -- exceeds their sizes (padded types).
1891 declare
1894 begin
1905 -- We set the component size for all cases 1-64
1909 -- Actual packing is not needed for 8,16,32,64
1910 -- Also not needed for 24 if alignment is 1
1917 then
1918 -- Here the array was requested to be packed, but
1919 -- the packing request had no effect, so Is_Packed
1920 -- is reset.
1922 -- Note: semantically this means that we lose
1923 -- track of the fact that a derived type inherited
1924 -- a pack pragma that was non-effective, but that
1925 -- seems fine.
1927 -- We regard a Pack pragma as a request to set a
1928 -- representation characteristic, and this request
1929 -- may be ignored.
1933 -- In all other cases, packing is indeed needed
1935 else
1944 -- If any of the index types was an enumeration type with
1945 -- a non-standard rep clause, then we indicate that the
1946 -- array type is always packed (even if it is not bit packed).
1956 -- If the array is packed, we must create the packed array
1957 -- type to be used to actually implement the type. This is
1958 -- only needed for real array types (not for string literal
1959 -- types, since they are present only for the front end).
1963 then
1967 -- Size information of packed array type is copied to the
1968 -- array type, since this is really the representation.
1974 -- For a class wide type, the corresponding specific type is
1975 -- frozen as well (RM 13.14(14))
1980 -- If the Class_Wide_Type is an Itype (when type is the anonymous
1981 -- parent of a derived type) and it is a library-level entity,
1982 -- generate an itype reference for it. Otherwise, its first
1983 -- explicit reference may be in an inner scope, which will be
1984 -- rejected by the back-end.
1988 then
1990 declare
1993 begin
1997 else
2003 -- For record (sub)type, freeze all the component types (RM
2004 -- 13.14(14). We test for E_Record_(sub)Type here, rather than
2005 -- using Is_Record_Type, because we don't want to attempt the
2006 -- freeze for the case of a private type with record extension
2007 -- (we will do that later when the full type is frozen).
2011 then
2014 -- For a concurrent type, freeze corresponding record type. This
2015 -- does not correpond to any specific rule in the RM, but the
2016 -- record type is essentially part of the concurrent type.
2017 -- Freeze as well all local entities. This includes record types
2018 -- created for entry parameter blocks, and whatever local entities
2019 -- may appear in the private part.
2023 Freeze_And_Append
2040 -- Private types are required to point to the same freeze node
2041 -- as their corresponding full views. The freeze node itself
2042 -- has to point to the partial view of the entity (because
2043 -- from the partial view, we can retrieve the full view, but
2044 -- not the reverse). However, in order to freeze correctly,
2045 -- we need to freeze the full view. If we are freezing at the
2046 -- end of a scope (or within the scope of the private type),
2047 -- the partial and full views will have been swapped, the
2048 -- full view appears first in the entity chain and the swapping
2049 -- mechanism enusres that the pointers are properly set (on
2050 -- scope exit).
2052 -- If we encounter the partial view before the full view
2053 -- (e.g. when freezing from another scope), we freeze the
2054 -- full view, and then set the pointers appropriately since
2055 -- we cannot rely on swapping to fix things up (subtypes in an
2056 -- outer scope might not get swapped).
2060 then
2061 -- Case of full view present
2065 -- If full view has already been frozen, then no
2066 -- further processing is required
2074 -- Otherwise freeze full view and patch the pointers
2076 else
2079 then
2080 Freeze_And_Append
2092 else
2093 -- {Incomplete,Private}_Subtypes
2094 -- with Full_Views constrained by discriminants
2104 -- AI-117 requires that the convention of a partial view
2105 -- be the same as the convention of the full view. Note
2106 -- that this is a recognized breach of privacy, but it's
2107 -- essential for logical consistency of representation,
2108 -- and the lack of a rule in RM95 was an oversight.
2115 -- Size information is copied from the full view to the
2116 -- incomplete or private view for consistency
2118 -- We skip this is the full view is not a type. This is
2119 -- very strange of course, and can only happen as a result
2120 -- of certain illegalities, such as a premature attempt to
2121 -- derive from an incomplete type.
2130 -- Case of no full view present. If entity is derived or subtype,
2131 -- it is safe to freeze, correctness depends on the frozen status
2132 -- of parent. Otherwise it is either premature usage, or a Taft
2133 -- amendment type, so diagnosis is at the point of use and the
2134 -- type might be frozen later.
2138 then
2141 else
2146 -- For access subprogram, freeze types of all formals, the return
2147 -- type was already frozen, since it is the Etype of the function.
2156 -- If the return type requires a transient scope, and we are on
2157 -- a target allowing functions to return with a depressed stack
2158 -- pointer, then we mark the function as requiring this treatment.
2160 if Functions_Return_By_DSP_On_Target
2162 then
2168 -- For access to a protected subprogram, freeze the equivalent
2169 -- type (however this is not set if we are not generating code)
2170 -- or if this is an anonymous type used just for resolution).
2175 then
2179 -- Generic types are never seen by the back-end, and are also not
2180 -- processed by the expander (since the expander is turned off for
2181 -- generic processing), so we never need freeze nodes for them.
2187 -- Some special processing for non-generic types to complete
2188 -- representation details not known till the freeze point.
2201 then
2205 -- If the current entity is an array or record subtype and has
2206 -- discriminants used to constrain it, it must not freeze, because
2207 -- Freeze_Entity nodes force Gigi to process the frozen type.
2213 declare
2218 begin
2226 then
2243 then
2245 declare
2248 begin
2256 then
2269 -- AI-117 requires that all new primitives of a tagged type
2270 -- must inherit the convention of the full view of the type.
2271 -- Inherited and overriding operations are defined to inherit
2272 -- the convention of their parent or overridden subprogram
2273 -- (also specified in AI-117), and that will have occurred
2274 -- earlier (in Derive_Subprogram and New_Overloaded_Entity).
2275 -- Here we set the convention of primitives that are still
2276 -- convention Ada, which will ensure that any new primitives
2277 -- inherit the type's convention. Class-wide types can have
2278 -- a foreign convention inherited from their specific type,
2279 -- but are excluded from this since they don't have any
2280 -- associated primitives.
2285 then
2286 declare
2290 begin
2302 -- Now that all types from which E may depend are frozen, see
2303 -- if the size is known at compile time, if it must be unsigned,
2304 -- or if strict alignent is required
2313 -- Do not allow a size clause for a type which does not have a size
2314 -- that is known at compile time
2318 then
2319 Error_Msg_N
2324 -- Remaining process is to set/verify the representation information,
2325 -- in particular the size and alignment values. This processing is
2326 -- not required for generic types, since generic types do not play
2327 -- any part in code generation, and so the size and alignment values
2328 -- for suhc types are irrelevant.
2333 -- Otherwise we call the layout procedure
2335 else
2339 -- End of freeze processing for type entities
2342 -- Here is where we logically freeze the current entity. If it has a
2343 -- freeze node, then this is the point at which the freeze node is
2344 -- linked into the result list.
2348 -- If a freeze node is already allocated, use it, otherwise allocate
2349 -- a new one. The preallocation happens in the case of anonymous base
2350 -- types, where we preallocate so that we can set First_Subtype_Link.
2351 -- Note that we reset the Sloc to the current freeze location.
2357 else
2369 else
2375 -- When a type is frozen, the first subtype of the type is frozen as
2376 -- well (RM 13.14(15)). This has to be done after freezing the type,
2377 -- since obviously the first subtype depends on its own base type.
2382 -- If we just froze a tagged non-class wide record, then freeze the
2383 -- corresponding class-wide type. This must be done after the tagged
2384 -- type itself is frozen, because the class-wide type refers to the
2385 -- tagged type which generates the class.
2390 then
2397 -- Special handling for subprograms
2401 -- If subprogram has address clause then reset Is_Public flag, since
2402 -- we do not want the backend to generate external references.
2406 then
2409 -- If no address clause and not intrinsic, then for imported
2410 -- subprogram in main unit, generate descriptor if we are in
2411 -- Propagate_Exceptions mode.
2413 elsif Propagate_Exceptions
2417 then
2422 Generate_Subprogram_Descriptor_For_Imported_Subprogram
2431 -----------------------------
2432 -- Freeze_Enumeration_Type --
2433 -----------------------------
2436 begin
2440 then
2443 else
2448 -----------------------
2449 -- Freeze_Expression --
2450 -----------------------
2461 -- This flag is set true if the entity must be frozen outside the
2462 -- current subprogram. This happens in the case of expander generated
2463 -- subprograms (_Init_Proc, _Input, _Output, _Read, _Write) which do
2464 -- not freeze all entities like other bodies, but which nevertheless
2465 -- may reference entities that have to be frozen before the body and
2466 -- obviously cannot be frozen inside the body.
2469 -- Given an N_Handled_Sequence_Of_Statements node N, determines whether
2470 -- it is the handled statement sequence of an expander generated
2471 -- subprogram (init proc, or stream subprogram). If so, it returns
2472 -- True, otherwise False.
2477 begin
2480 else
2487 else
2496 then
2498 else
2505 -- Start of processing for Freeze_Expression
2507 begin
2508 -- Immediate return if freezing is inhibited. This flag is set by
2509 -- the analyzer to stop freezing on generated expressions that would
2510 -- cause freezing if they were in the source program, but which are
2511 -- not supposed to freeze, since they are created.
2517 -- If expression is non-static, then it does not freeze in a default
2518 -- expression, see section "Handling of Default Expressions" in the
2519 -- spec of package Sem for further details. Note that we have to
2520 -- make sure that we actually have a real expression (if we have
2521 -- a subtype indication, we can't test Is_Static_Expression!)
2523 if In_Def_Exp
2526 then
2530 -- Freeze type of expression if not frozen already
2534 then
2536 else
2540 -- For entity name, freeze entity if not frozen already. A special
2541 -- exception occurs for an identifier that did not come from source.
2542 -- We don't let such identifiers freeze a non-internal entity, i.e.
2543 -- an entity that did come from source, since such an identifier was
2544 -- generated by the expander, and cannot have any semantic effect on
2545 -- the freezing semantics. For example, this stops the parameter of
2546 -- an initialization procedure from freezing the variable.
2553 then
2556 else
2560 -- For an allocator freeze designated type if not frozen already.
2562 -- For an aggregate whose component type is an access type, freeze
2563 -- the designated type now, so that its freeze does not appear within
2564 -- the loop that might be created in the expansion of the aggregate.
2565 -- If the designated type is a private type without full view, the
2566 -- expression cannot contain an allocator, so the type is not frozen.
2577 then
2581 when N_Selected_Component |
2582 N_Indexed_Component |
2583 N_Slice =>
2597 then
2601 -- All done if nothing needs freezing
2606 then
2610 -- Loop for looking at the right place to insert the freeze nodes
2611 -- exiting from the loop when it is appropriate to insert the freeze
2612 -- node before the current node P.
2614 -- Also checks some special exceptions to the freezing rules. These
2615 -- cases result in a direct return, bypassing the freeze action.
2618 loop
2621 -- If we don't have a parent, then we are not in a well-formed
2622 -- tree. This is an unusual case, but there are some legitimate
2623 -- situations in which this occurs, notably when the expressions
2624 -- in the range of a type declaration are resolved. We simply
2625 -- ignore the freeze request in this case. Is this right ???
2631 -- See if we have got to an appropriate point in the tree
2635 -- A special test for the exception of (RM 13.14(8)) for the
2636 -- case of per-object expressions (RM 3.8(18)) occurring in a
2637 -- component definition or a discrete subtype definition. Note
2638 -- that we test for a component declaration which includes both
2639 -- cases we are interested in, and furthermore the tree does not
2640 -- have explicit nodes for either of these two constructs.
2644 -- The case we want to test for here is an identifier that is
2645 -- a per-object expression, this is either a discriminant that
2646 -- appears in a context other than the component declaration
2647 -- or it is a reference to the type of the enclosing construct.
2649 -- For either of these cases, we skip the freezing
2651 if not In_Default_Expression
2654 then
2655 -- We recognize the discriminant case by just looking for
2656 -- a reference to a discriminant. It can only be one for
2657 -- the enclosing construct. Skip freezing in this case.
2662 -- For the case of a reference to the enclosing record,
2663 -- (or task or protected type), we look for a type that
2664 -- matches the current scope.
2671 -- If we have an enumeration literal that appears as the
2672 -- choice in the aggregate of an enumeration representation
2673 -- clause, then freezing does not occur (RM 13.14(9)).
2677 -- The case we are looking for is an enumeration literal
2681 then
2682 -- If enumeration literal appears directly as the choice,
2683 -- do not freeze (this is the normal non-overloade case)
2687 then
2690 -- If enumeration literal appears as the name of a
2691 -- function which is the choice, then also do not freeze.
2692 -- This happens in the overloaded literal case, where the
2693 -- enumeration literal is temporarily changed to a function
2694 -- call for overloading analysis purposes.
2697 and then
2699 and then
2701 then
2706 -- Normally if the parent is a handled sequence of statements,
2707 -- then the current node must be a statement, and that is an
2708 -- appropriate place to insert a freeze node.
2712 -- An exception occurs when the sequence of statements is
2713 -- for an expander generated body that did not do the usual
2714 -- freeze all operation. In this case we usually want to
2715 -- freeze outside this body, not inside it, and we skip
2716 -- past the subprogram body that we are inside.
2720 -- However, we *do* want to freeze at this point if we have
2721 -- an entity to freeze, and that entity is declared *inside*
2722 -- the body of the expander generated procedure. This case
2723 -- is recognized by the scope of the type, which is either
2724 -- the spec for some enclosing body, or (in the case of
2725 -- init_procs, for which there are no separate specs) the
2726 -- current scope.
2728 declare
2732 begin
2737 or else
2739 then
2745 then
2751 -- If not that exception to the exception, then this is
2752 -- where we delay the freeze till outside the body.
2757 -- Here if normal case where we are in handled statement
2758 -- sequence and want to do the insertion right there.
2760 else
2764 -- If parent is a body or a spec or a block, then the current
2765 -- node is a statement or declaration and we can insert the
2766 -- freeze node before it.
2768 when N_Package_Specification |
2769 N_Package_Body |
2770 N_Subprogram_Body |
2771 N_Task_Body |
2772 N_Protected_Body |
2773 N_Entry_Body |
2776 -- The expander is allowed to define types in any statements list,
2777 -- so any of the following parent nodes also mark a freezing point
2778 -- if the actual node is in a list of statements or declarations.
2780 when N_Exception_Handler |
2781 N_If_Statement |
2782 N_Elsif_Part |
2783 N_Case_Statement_Alternative |
2784 N_Compilation_Unit_Aux |
2785 N_Selective_Accept |
2786 N_Accept_Alternative |
2787 N_Delay_Alternative |
2788 N_Conditional_Entry_Call |
2789 N_Entry_Call_Alternative |
2790 N_Triggering_Alternative |
2791 N_Abortable_Part |
2792 N_Freeze_Entity =>
2796 -- Note: The N_Loop_Statement is a special case. A type that
2797 -- appears in the source can never be frozen in a loop (this
2798 -- occurs only because of a loop expanded by the expander),
2799 -- so we keep on going. Otherwise we terminate the search.
2800 -- Same is true of any entity which comes from source. (if they
2801 -- have a predefined type, that type does not appear to come
2802 -- from source, but the entity should not be frozen here).
2808 -- For all other cases, keep looking at parents
2814 -- We fall through the case if we did not yet find the proper
2815 -- place in the free for inserting the freeze node, so climb!
2820 -- If the expression appears in a record or an initialization
2821 -- procedure, the freeze nodes are collected and attached to
2822 -- the current scope, to be inserted and analyzed on exit from
2823 -- the scope, to insure that generated entities appear in the
2824 -- correct scope. If the expression is a default for a discriminant
2825 -- specification, the scope is still void. The expression can also
2826 -- appear in the discriminant part of a private or concurrent type.
2828 -- The other case requiring this special handling is if we are in
2829 -- a default expression, since in that case we are about to freeze
2830 -- a static type, and the freeze scope needs to be the outer scope,
2831 -- not the scope of the subprogram with the default parameter.
2833 -- For default expressions in generic units, the Move_Freeze_Nodes
2834 -- mechanism (see sem_ch12.adb) takes care of placing them at the
2835 -- proper place, after the generic unit.
2838 or else Freeze_Outside
2843 then
2844 declare
2848 begin
2865 then
2866 Scope_Stack.Table
2868 Freeze_Nodes;
2869 else
2879 -- Now we have the right place to do the freezing. First, a special
2880 -- adjustment, if we are in default expression analysis mode, these
2881 -- freeze actions must not be thrown away (normally all inserted
2882 -- actions are thrown away in this mode. However, the freeze actions
2883 -- are from static expressions and one of the important reasons we
2884 -- are doing this special analysis is to get these freeze actions.
2885 -- Therefore we turn off the In_Default_Expression mode to propagate
2886 -- these freeze actions. This also means they get properly analyzed
2887 -- and expanded.
2891 -- Freeze the designated type of an allocator (RM 13.14(12))
2897 -- Freeze type of expression (RM 13.14(9)). Note that we took care of
2898 -- the enumeration representation clause exception in the loop above.
2904 -- Freeze name if one is present (RM 13.14(10))
2913 -----------------------------
2914 -- Freeze_Fixed_Point_Type --
2915 -----------------------------
2917 -- Certain fixed-point types and subtypes, including implicit base
2918 -- types and declared first subtypes, have not yet set up a range.
2919 -- This is because the range cannot be set until the Small and Size
2920 -- values are known, and these are not known till the type is frozen.
2922 -- To signal this case, Scalar_Range contains an unanalyzed syntactic
2923 -- range whose bounds are unanalyzed real literals. This routine will
2924 -- recognize this case, and transform this range node into a properly
2925 -- typed range with properly analyzed and resolved values.
2943 -- Returns size of type with given bounds. Also leaves these
2944 -- bounds set as the current bounds of the Typ.
2947 begin
2953 -- Start of processing for Freeze_Fixed_Point_Type;
2955 begin
2956 -- If Esize of a subtype has not previously been set, set it now
2963 else
2968 -- Immediate return if the range is already analyzed. This means
2969 -- that the range is already set, and does not need to be computed
2970 -- by this routine.
2976 -- Immediate return if either of the bounds raises Constraint_Error
2980 then
2987 -- Ordinary fixed-point case
2991 -- For the ordinary fixed-point case, we are allowed to fudge the
2992 -- end-points up or down by small. Generally we prefer to fudge
2993 -- up, i.e. widen the bounds for non-model numbers so that the
2994 -- end points are included. However there are cases in which this
2995 -- cannot be done, and indeed cases in which we may need to narrow
2996 -- the bounds. The following circuit makes the decision.
2998 -- Note: our terminology here is that Incl_EP means that the
2999 -- bounds are widened by Small if necessary to include the end
3000 -- points, and Excl_EP means that the bounds are narrowed by
3001 -- Small to exclude the end-points if this reduces the size.
3003 -- Note that in the Incl case, all we care about is including the
3004 -- end-points. In the Excl case, we want to narrow the bounds as
3005 -- much as permitted by the RM, to give the smallest possible size.
3022 begin
3023 -- First step. Base types are required to be symmetrical. Right
3024 -- now, the base type range is a copy of the first subtype range.
3025 -- This will be corrected before we are done, but right away we
3026 -- need to deal with the case where both bounds are non-negative.
3027 -- In this case, we set the low bound to the negative of the high
3028 -- bound, to make sure that the size is computed to include the
3029 -- required sign. Note that we do not need to worry about the
3030 -- case of both bounds negative, because the sign will be dealt
3031 -- with anyway. Furthermore we can't just go making such a bound
3032 -- symmetrical, since in a twos-complement system, there is an
3033 -- extra negative value which could not be accomodated on the
3034 -- positive side.
3039 then
3044 -- Compute the fudged bounds. If the number is a model number,
3045 -- then we do nothing to include it, but we are allowed to
3046 -- backoff to the next adjacent model number when we exclude
3047 -- it. If it is not a model number then we straddle the two
3048 -- values with the model numbers on either side.
3054 else
3058 -- The low value excluding the end point is Small greater, but
3059 -- we do not do this exclusion if the low value is positive,
3060 -- since it can't help the size and could actually hurt by
3061 -- crossing the high bound.
3065 else
3069 -- Similar processing for upper bound and high value
3075 else
3081 else
3085 -- One further adjustment is needed. In the case of subtypes,
3086 -- we cannot go outside the range of the base type, or we get
3087 -- peculiarities, and the base type range is already set. This
3088 -- only applies to the Incl values, since clearly the Excl
3089 -- values are already as restricted as they are allowed to be.
3096 -- Get size including and excluding end points
3101 -- No need to exclude end-points if it does not reduce size
3111 -- Now we set the actual size to be used. We want to use the
3112 -- bounds fudged up to include the end-points but only if this
3113 -- can be done without violating a specifically given size
3114 -- size clause or causing an unacceptable increase in size.
3116 -- Case of size clause given
3120 -- Use the inclusive size only if it is consistent with
3121 -- the explicitly specified size.
3128 -- If the inclusive size is too large, we try excluding
3129 -- the end-points (will be caught later if does not work).
3131 else
3137 -- Case of size clause not given
3139 else
3140 -- If we have a base type whose corresponding first subtype
3141 -- has an explicit size that is large enough to include our
3142 -- end-points, then do so. There is no point in working hard
3143 -- to get a base type whose size is smaller than the specified
3144 -- size of the first subtype.
3150 then
3155 -- If excluding the end-points makes the size smaller and
3156 -- results in a size of 8,16,32,64, then we take the smaller
3157 -- size. For the 64 case, this is compulsory. For the other
3158 -- cases, it seems reasonable. We like to include end points
3159 -- if we can, but not at the expense of moving to the next
3160 -- natural boundary of size.
3163 and then
3168 then
3173 -- Otherwise we can definitely include the end points
3175 else
3181 -- One pathological case: normally we never fudge a low
3182 -- bound down, since it would seem to increase the size
3183 -- (if it has any effect), but for ranges containing a
3184 -- single value, or no values, the high bound can be
3185 -- small too large. Consider:
3187 -- type t is delta 2.0**(-14)
3188 -- range 131072.0 .. 0;
3190 -- That lower bound is *just* outside the range of 32
3191 -- bits, and does need fudging down in this case. Note
3192 -- that the bounds will always have crossed here, since
3193 -- the high bound will be fudged down if necessary, as
3194 -- in the case of:
3196 -- type t is delta 2.0**(-14)
3197 -- range 131072.0 .. 131072.0;
3199 -- So we can detect the situation by looking for crossed
3200 -- bounds, and if the bounds are crossed, and the low
3201 -- bound is greater than zero, we will always back it
3202 -- off by small, since this is completely harmless.
3209 -- And of course, we need to do exactly the same parallel
3210 -- fudge for flat ranges in the negative region.
3223 -- For the decimal case, none of this fudging is required, since there
3224 -- are no end-point problems in the decimal case (the end-points are
3225 -- always included).
3227 else
3231 -- At this stage, the actual size has been calculated and the proper
3232 -- required bounds are stored in the low and high bounds.
3236 Error_Msg_N
3241 -- Check size against explicit given size
3247 Error_Msg_NE
3251 else
3255 -- Increase size to next natural boundary if no size clause given
3257 else
3264 else
3272 -- If we have a base type, then expand the bounds so that they
3273 -- extend to the full width of the allocated size in bits, to
3274 -- avoid junk range checks on intermediate computations.
3281 -- Final step is to reanalyze the bounds using the proper type
3282 -- and set the Corresponding_Integer_Value fields of the literals.
3288 -- Resolve with universal fixed if the base type, and the base
3289 -- type if it is a subtype. Note we can't resolve the base type
3290 -- with itself, that would be a reference before definition.
3294 else
3298 -- Set corresponding integer value for bound
3300 Set_Corresponding_Integer_Value
3303 -- Similar processing for high bound
3311 else
3315 Set_Corresponding_Integer_Value
3318 -- Set type of range to correspond to bounds
3322 -- Set Esize to calculated size and also set RM_Size
3326 -- Set RM_Size if not already set. If already set, check value
3328 declare
3331 begin
3336 Error_Msg_NE
3341 else
3348 ------------------
3349 -- Freeze_Itype --
3350 ------------------
3355 begin
3364 --------------------------
3365 -- Freeze_Static_Object --
3366 --------------------------
3371 -- Exception raised if the type of a static object cannot be made
3372 -- static. This happens if the type depends on non-global objects.
3375 -- Called to ensure that an expression used as part of a type
3376 -- definition is statically allocatable, which means that the type
3377 -- of the expression is statically allocatable, and the expression
3378 -- is either static, or a reference to a library level constant.
3381 -- Called to mark a type as static, checking that it is possible
3382 -- to set the type as static. If it is not possible, then the
3383 -- exception Cannot_Be_Static is raised.
3385 -----------------------------
3386 -- Ensure_Expression_Is_SA --
3387 -----------------------------
3392 begin
3404 then
3412 -----------------------
3413 -- Ensure_Type_Is_SA --
3414 -----------------------
3420 begin
3421 -- If type is library level, we are all set
3427 -- We are also OK if the type is already marked as statically
3428 -- allocated, which means we processed it before.
3434 -- Mark type as statically allocated
3438 -- Check that it is safe to statically allocate this type
3456 declare
3460 begin
3473 else
3483 then
3502 else
3507 -- Start of processing for Freeze_Static_Object
3509 begin
3512 exception
3515 -- If the object that cannot be static is imported or exported,
3516 -- then we give an error message saying that this object cannot
3517 -- be imported or exported.
3520 Error_Msg_N
3523 -- Otherwise must be exported, something is wrong if compiler
3524 -- is marking something as statically allocated which cannot be).
3527 Error_Msg_N
3532 -----------------------
3533 -- Freeze_Subprogram --
3534 -----------------------
3540 begin
3541 -- Subprogram may not have an address clause unless it is imported
3545 Error_Msg_N
3552 -- For non-foreign convention subprograms, this is where we create
3553 -- the extra formals (for accessibility level and constrained bit
3554 -- information). We delay this till the freeze point precisely so
3555 -- that we know the convention!
3561 -- If this is convention Ada and a Valued_Procedure, that's odd
3566 then
3567 Error_Msg_N
3572 -- Case of foreign convention
3574 else
3577 -- For foreign conventions, do not permit return of an
3578 -- unconstrained array.
3580 -- Note: we *do* allow a return by descriptor for the VMS case,
3581 -- though here there is probably more to be done ???
3586 -- If no return type, probably some other error, e.g. a
3587 -- missing full declaration, so ignore.
3592 -- If the return type is generic, we have emitted a warning
3593 -- earlier on, and there is nothing else to check here.
3594 -- Specific instantiations may lead to erroneous behavior.
3602 then
3603 Error_Msg_NE
3610 -- If any of the formals for an exported foreign convention
3611 -- subprogram have defaults, then emit an appropriate warning
3612 -- since this is odd (default cannot be used from non-Ada code)
3618 Error_Msg_N
3628 -- For VMS, descriptor mechanisms for parameters are allowed only
3629 -- for imported subprograms.
3636 Error_Msg_N
3638 Error_Msg_N
3649 -----------------------
3650 -- Is_Fully_Defined --
3651 -----------------------
3653 -- Should this be in Sem_Util ???
3656 begin
3659 else
3665 ---------------------------------
3666 -- Process_Default_Expressions --
3667 ---------------------------------
3669 procedure Process_Default_Expressions
3672 is
3679 begin
3682 -- A subprogram instance and its associated anonymous subprogram
3683 -- share their signature. The default expression functions are defined
3684 -- in the wrapper packages for the anonymous subprogram, and should
3685 -- not be generated again for the instance.
3690 then
3699 -- We work with a copy of the default expression because we
3700 -- do not want to disturb the original, since this would mess
3701 -- up the conformance checking.
3705 -- The analysis of the expression may generate insert actions,
3706 -- which of course must not be executed. We wrap those actions
3707 -- in a procedure that is not called, and later on eliminated.
3708 -- The following cases have no side-effects, and are analyzed
3709 -- directly.
3720 and then
3723 then
3725 -- If there is no default function, we must still do a full
3726 -- analyze call on the default value, to ensure that all
3727 -- error checks are performed, e.g. those associated with
3728 -- static evaluation. Note that this branch will always be
3729 -- taken if the analyzer is turned off (but we still need the
3730 -- error checks).
3732 -- Note: the setting of parent here is to meet the requirement
3733 -- that we can only analyze the expression while attached to
3734 -- the tree. Really the requirement is that the parent chain
3735 -- be set, we don't actually need to be in the tree.
3740 -- Default expressions are resolved with their own type if the
3741 -- context is generic, to avoid anomalies with private types.
3745 else
3749 -- If that resolved expression will raise constraint error,
3750 -- then flag the default value as raising constraint error.
3751 -- This allows a proper error message on the calls.
3757 -- If the default is a parameterless call, we use the name of
3758 -- the called function directly, and there is no body to build.
3762 then
3765 -- Else construct and analyze the body of a wrapper procedure
3766 -- that contains an object declaration to hold the expression.
3767 -- Given that this is done only to complete the analysis, it
3768 -- simpler to build a procedure than a function which might
3769 -- involve secondary stack expansion.
3771 else
3772 Dnam :=
3775 Dbody :=
3777 Specification =>
3783 Defining_Identifier =>
3786 Object_Definition =>
3790 Handled_Statement_Sequence =>
3808 ----------------------------------------
3809 -- Set_Component_Alignment_If_Not_Set --
3810 ----------------------------------------
3813 begin
3814 -- Ignore if not base type, subtypes don't need anything
3820 -- Do not override existing representation
3831 else
3832 Set_Component_Alignment
3838 ---------------------------
3839 -- Set_Debug_Info_Needed --
3840 ---------------------------
3843 begin
3847 then
3849 else
3860 declare
3862 begin
3872 declare
3874 begin