1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 -- This package deals with the implementation of the Restrictions pragma
31 with Types
; use Types
;
32 with Uintp
; use Uintp
;
36 type Restriction_Id
is new Rident
.Restriction_Id
;
37 -- The type Restriction_Id defines the set of restriction identifiers,
38 -- which take no parameter (i.e. they are either present or not present).
39 -- The actual definition is in the separate package Rident, so that
40 -- it can easily be accessed by the binder without dragging in lots of
43 subtype All_Restrictions
is
45 Restriction_Id
(Rident
.All_Restrictions
'First) ..
46 Restriction_Id
(Rident
.All_Restrictions
'Last);
47 -- All restriction identifiers
49 subtype Partition_Restrictions
is
51 Restriction_Id
(Rident
.Partition_Restrictions
'First) ..
52 Restriction_Id
(Rident
.Partition_Restrictions
'Last);
53 -- Range of restriction identifiers that are checked by the binder
55 subtype Compilation_Unit_Restrictions
is
57 Restriction_Id
(Rident
.Compilation_Unit_Restrictions
'First) ..
58 Restriction_Id
(Rident
.Compilation_Unit_Restrictions
'Last);
59 -- Range of restriction identifiers not checked by binder
61 type Restriction_Parameter_Id
is new Rident
.Restriction_Parameter_Id
;
62 -- The type Restriction_Parameter_Id records cases where a parameter is
63 -- present in the corresponding pragma. These cases are not checked for
64 -- consistency by the binder. The actual definition is in the separate
65 -- package Rident for consistency.
67 type Restrictions_Flags
is array (Restriction_Id
) of Boolean;
68 -- Type used for arrays indexed by Restriction_Id.
70 Restrictions
: Restrictions_Flags
:= (others => False);
71 -- Corresponding entry is False if restriction is not active, and
72 -- True if the restriction is active, i.e. if a pragma Restrictions
73 -- has been seen anywhere. Note that we are happy to pick up any
74 -- restrictions pragmas in with'ed units, since we are required to
75 -- be consistent at link time, and we might as well find the error
76 -- at compile time. Clients must NOT use this array for checking to
77 -- see if a restriction is violated, instead it is required that the
78 -- Check_Restriction subprograms be used for this purpose. The only
79 -- legitimate direct use of this array is when the code is modified
80 -- as a result of the restriction in some way.
82 Restrictions_Loc
: array (Restriction_Id
) of Source_Ptr
;
83 -- Locations of Restrictions pragmas for error message purposes.
84 -- Valid only if corresponding entry in Restrictions is set.
86 Main_Restrictions
: Restrictions_Flags
:= (others => False);
87 -- This variable saves the cumulative restrictions in effect compiling
88 -- any unit that is part of the extended main unit (i.e. the compiled
89 -- unit, its spec if any, and its subunits if any). The reason we keep
90 -- track of this is for the information that goes to the binder about
91 -- restrictions that are set. The binder will identify a unit that has
92 -- a restrictions pragma for error message purposes, and we do not want
93 -- to pick up a restrictions pragma in a with'ed unit for this purpose.
95 Violations
: Restrictions_Flags
:= (others => False);
96 -- Corresponding entry is False if the restriction has not been
97 -- violated in the current main unit, and True if it has been violated.
99 Restriction_Parameters
:
100 array (Restriction_Parameter_Id
) of Uint
:= (others => No_Uint
);
101 -- This array indicates the setting of restriction parameter identifier
102 -- values. All values are initially set to No_Uint indicating that the
103 -- parameter is not set, and are set to the appropriate non-negative
104 -- value if a Restrictions pragma specifies the corresponding
105 -- restriction parameter identifier with an appropriate value.
107 Restriction_Parameters_Loc
:
108 array (Restriction_Parameter_Id
) of Source_Ptr
;
109 -- Locations of Restrictions pragmas for error message purposes.
110 -- Valid only if corresponding entry in Restriction_Parameters is
111 -- set to a value other than No_Uint.
113 type Unit_Entry
is record
114 Res_Id
: Restriction_Id
;
115 Filenm
: String (1 .. 8);
118 type Unit_Array_Type
is array (Positive range <>) of Unit_Entry
;
120 Unit_Array
: constant Unit_Array_Type
:= (
121 (No_Asynchronous_Control
, "a-astaco"),
122 (No_Calendar
, "a-calend"),
123 (No_Calendar
, "calendar"),
124 (No_Delay
, "a-calend"),
125 (No_Delay
, "calendar"),
126 (No_Dynamic_Priorities
, "a-dynpri"),
135 (No_Task_Attributes
, "a-tasatt"),
136 (No_Streams
, "a-stream"),
137 (No_Unchecked_Conversion
, "a-unccon"),
138 (No_Unchecked_Conversion
, "unchconv"),
139 (No_Unchecked_Deallocation
, "a-uncdea"),
140 (No_Unchecked_Deallocation
, "unchdeal"));
141 -- This array defines the mapping between restriction identifiers and
142 -- predefined language files containing units for which the identifier
143 -- forbids semantic dependence.
145 type Save_Compilation_Unit_Restrictions
is private;
146 -- Type used for saving and restoring compilation unit restrictions.
147 -- See Compilation_Unit_Restrictions_[Save|Restore] subprograms.
149 -- The following map has True for all GNAT pragmas. It is used to
150 -- implement pragma Restrictions (No_Implementation_Restrictions)
151 -- (which is why this restriction itself is excluded from the list).
153 Implementation_Restriction
: Restrictions_Flags
:=
154 (Boolean_Entry_Barriers
=> True,
156 No_Dynamic_Interrupts
=> True,
157 No_Enumeration_Maps
=> True,
158 No_Entry_Calls_In_Elaboration_Code
=> True,
159 No_Entry_Queue
=> True,
160 No_Exception_Handlers
=> True,
161 No_Implicit_Conditionals
=> True,
162 No_Implicit_Dynamic_Code
=> True,
163 No_Implicit_Loops
=> True,
164 No_Local_Protected_Objects
=> True,
165 No_Protected_Type_Allocators
=> True,
166 No_Relative_Delay
=> True,
168 No_Secondary_Stack
=> True,
169 No_Select_Statements
=> True,
170 No_Standard_Storage_Pools
=> True,
172 No_Task_Attributes
=> True,
173 No_Task_Termination
=> True,
175 No_Wide_Characters
=> True,
176 Static_Priorities
=> True,
177 Static_Storage_Size
=> True,
178 No_Implementation_Attributes
=> True,
179 No_Implementation_Pragmas
=> True,
180 No_Elaboration_Code
=> True,
187 procedure Check_Restricted_Unit
(U
: Unit_Name_Type
; N
: Node_Id
);
188 -- Checks if loading of unit U is prohibited by the setting of some
189 -- restriction (e.g. No_IO restricts the loading of unit Ada.Text_IO).
190 -- If a restriction exists post error message at the given node.
192 procedure Check_Restriction
(R
: Restriction_Id
; N
: Node_Id
);
193 -- Checks that the given restriction is not set, and if it is set, an
194 -- appropriate message is posted on the given node. Also records the
195 -- violation in the violations array. Note that it is mandatory to
196 -- always use this routine to check if a restriction is violated. Such
197 -- checks must never be done directly by the caller, since otherwise
198 -- they are not properly recorded in the violations array.
200 procedure Check_Restriction
201 (R
: Restriction_Parameter_Id
;
203 -- Checks that the given restriction parameter identifier is not set to
204 -- zero. If it is set to zero, then the node N is replaced by a node
205 -- that raises Storage_Error, and a warning is issued.
207 procedure Check_Restriction
208 (R
: Restriction_Parameter_Id
;
211 -- Checks that the count in V does not exceed the maximum value of the
212 -- restriction parameter value corresponding to the given restriction
213 -- parameter identifier (if it has been set). If the count in V exceeds
214 -- the maximum, then post an error message on node N.
216 procedure Check_Elaboration_Code_Allowed
(N
: Node_Id
);
217 -- Tests to see if elaboration code is allowed by the current restrictions
218 -- settings. This function is called by Gigi when it needs to define
219 -- an elaboration routine. If elaboration code is not allowed, an error
220 -- message is posted on the node given as argument.
222 function No_Exception_Handlers_Set
return Boolean;
223 -- Test to see if current restrictions settings specify that no exception
224 -- handlers are present. This function is called by Gigi when it needs to
225 -- expand an AT END clean up identifier with no exception handler.
227 function Compilation_Unit_Restrictions_Save
228 return Save_Compilation_Unit_Restrictions
;
229 -- This function saves the compilation unit restriction settings, and
230 -- resets them to False. This is used e.g. when compiling a with'ed
231 -- unit to avoid incorrectly propagating restrictions. Note that it
232 -- would not be wrong to also save and reset the partition restrictions,
233 -- since the binder would catch inconsistencies, but actually it is a
234 -- good thing to acquire restrictions from with'ed units if they are
235 -- required to be partition wide, because it allows the restriction
236 -- violation message to be given at compile time instead of link time.
238 procedure Compilation_Unit_Restrictions_Restore
239 (R
: Save_Compilation_Unit_Restrictions
);
240 -- This is the corresponding restore procedure to restore restrictions
241 -- previously saved by Compilation_Unit_Restrictions_Save.
243 procedure Disallow_In_No_Run_Time_Mode
(Enode
: Node_Id
);
244 -- If in No_Run_Time mode, then the construct represented by Enode is
245 -- not permitted, and will be appropriately flagged.
247 procedure Set_No_Run_Time_Mode
;
248 -- Set the no run time mode, and associated restriction pragmas.
250 function Get_Restriction_Id
252 return Restriction_Id
;
253 -- Given an identifier name, determines if it is a valid restriction
254 -- identifier, and if so returns the corresponding Restriction_Id
255 -- value, otherwise returns Not_A_Restriction_Id.
257 function Get_Restriction_Parameter_Id
259 return Restriction_Parameter_Id
;
260 -- Given an identifier name, determines if it is a valid restriction
261 -- parameter identifier, and if so returns the corresponding
262 -- Restriction_Parameter_Id value, otherwise returns
263 -- Not_A_Restriction_Parameter_Id.
265 function Abort_Allowed
return Boolean;
266 pragma Inline
(Abort_Allowed
);
267 -- Tests to see if abort is allowed by the current restrictions settings.
268 -- For abort to be allowed, either No_Abort_Statements must be False,
269 -- or Max_Asynchronous_Select_Nesting must be non-zero.
271 function Restricted_Profile
return Boolean;
272 -- Tests to see if tasking operations follow the GNAT restricted run time
275 procedure Set_Ravenscar
;
276 -- Sets the set of rerstrictions fro Ravenscar
278 procedure Set_Restricted_Profile
;
279 -- Sets the set of restrictions for pragma Restricted_Run_Time
281 function Tasking_Allowed
return Boolean;
282 pragma Inline
(Tasking_Allowed
);
283 -- Tests to see if tasking operations are allowed by the current
284 -- restrictions settings. For tasking to be allowed Max_Tasks must
288 type Save_Compilation_Unit_Restrictions
is
289 array (Compilation_Unit_Restrictions
) of Boolean;
290 -- Type used for saving and restoring compilation unit restrictions.
291 -- See Compilation_Unit_Restrictions_[Save|Restore] subprograms.