===================================================================
@@ -26,6 +26,7 @@
with ALI; use ALI;
with Atree; use Atree;
with Casing; use Casing;
+with Debug; use Debug;
with Einfo; use Einfo;
with Errout; use Errout;
with Fname; use Fname;
@@ -1140,53 +1141,129 @@
end if;
end loop;
- -- Output first restrictions line
+ -- Positional case (only if debug flag -gnatd.R is set)
- Write_Info_Initiate ('R');
- Write_Info_Char (' ');
+ if Debug_Flag_Dot_RR then
- -- First the information for the boolean restrictions
+ -- Output first restrictions line
- for R in All_Boolean_Restrictions loop
- if Main_Restrictions.Set (R)
- and then not Restriction_Warnings (R)
- then
- Write_Info_Char ('r');
- elsif Main_Restrictions.Violated (R) then
- Write_Info_Char ('v');
- else
- Write_Info_Char ('n');
- end if;
- end loop;
+ Write_Info_Initiate ('R');
+ Write_Info_Char (' ');
- -- And now the information for the parameter restrictions
+ -- First the information for the boolean restrictions
- for RP in All_Parameter_Restrictions loop
- if Main_Restrictions.Set (RP)
- and then not Restriction_Warnings (RP)
- then
- Write_Info_Char ('r');
- Write_Info_Nat (Nat (Main_Restrictions.Value (RP)));
- else
- Write_Info_Char ('n');
- end if;
+ for R in All_Boolean_Restrictions loop
+ if Main_Restrictions.Set (R)
+ and then not Restriction_Warnings (R)
+ then
+ Write_Info_Char ('r');
+ elsif Main_Restrictions.Violated (R) then
+ Write_Info_Char ('v');
+ else
+ Write_Info_Char ('n');
+ end if;
+ end loop;
- if not Main_Restrictions.Violated (RP)
- or else RP not in Checked_Parameter_Restrictions
- then
- Write_Info_Char ('n');
- else
- Write_Info_Char ('v');
- Write_Info_Nat (Nat (Main_Restrictions.Count (RP)));
+ -- And now the information for the parameter restrictions
- if Main_Restrictions.Unknown (RP) then
- Write_Info_Char ('+');
+ for RP in All_Parameter_Restrictions loop
+ if Main_Restrictions.Set (RP)
+ and then not Restriction_Warnings (RP)
+ then
+ Write_Info_Char ('r');
+ Write_Info_Nat (Nat (Main_Restrictions.Value (RP)));
+ else
+ Write_Info_Char ('n');
end if;
- end if;
- end loop;
- Write_Info_EOL;
+ if not Main_Restrictions.Violated (RP)
+ or else RP not in Checked_Parameter_Restrictions
+ then
+ Write_Info_Char ('n');
+ else
+ Write_Info_Char ('v');
+ Write_Info_Nat (Nat (Main_Restrictions.Count (RP)));
+ if Main_Restrictions.Unknown (RP) then
+ Write_Info_Char ('+');
+ end if;
+ end if;
+ end loop;
+
+ Write_Info_EOL;
+
+ -- Named case (if debug flag -gnatd.R is not set)
+
+ else
+ declare
+ C : Character;
+
+ begin
+ -- Write RN header line with preceding blank line
+
+ Write_Info_EOL;
+ Write_Info_Initiate ('R');
+ Write_Info_Char ('N');
+ Write_Info_EOL;
+
+ -- First the lines for the boolean restrictions
+
+ for R in All_Boolean_Restrictions loop
+ if Main_Restrictions.Set (R)
+ and then not Restriction_Warnings (R)
+ then
+ C := 'R';
+ elsif Main_Restrictions.Violated (R) then
+ C := 'V';
+ else
+ goto Continue;
+ end if;
+
+ Write_Info_Initiate ('R');
+ Write_Info_Char (C);
+ Write_Info_Char (' ');
+ Write_Info_Str (All_Boolean_Restrictions'Image (R));
+ Write_Info_EOL;
+
+ <<Continue>>
+ null;
+ end loop;
+ end;
+
+ -- And now the lines for the parameter restrictions
+
+ for RP in All_Parameter_Restrictions loop
+ if Main_Restrictions.Set (RP)
+ and then not Restriction_Warnings (RP)
+ then
+ Write_Info_Initiate ('R');
+ Write_Info_Str ("R ");
+ Write_Info_Str (All_Parameter_Restrictions'Image (RP));
+ Write_Info_Char ('=');
+ Write_Info_Nat (Nat (Main_Restrictions.Value (RP)));
+ Write_Info_EOL;
+ end if;
+
+ if not Main_Restrictions.Violated (RP)
+ or else RP not in Checked_Parameter_Restrictions
+ then
+ null;
+ else
+ Write_Info_Initiate ('R');
+ Write_Info_Str ("V ");
+ Write_Info_Str (All_Parameter_Restrictions'Image (RP));
+ Write_Info_Char ('=');
+ Write_Info_Nat (Nat (Main_Restrictions.Count (RP)));
+
+ if Main_Restrictions.Unknown (RP) then
+ Write_Info_Char ('+');
+ end if;
+
+ Write_Info_EOL;
+ end if;
+ end loop;
+ end if;
+
-- Output R lines for No_Dependence entries
for J in No_Dependences.First .. No_Dependences.Last loop
===================================================================
@@ -262,6 +262,28 @@
-- -- R Restrictions --
-- ---------------------
+ -- There are two forms for R lines, positional and named. The positional
+ -- notation is now considered obsolescent, it is not generated by the most
+ -- recent versions of the compiler except under control of the debug switch
+ -- -gnatdR, but is still recognized by the binder.
+
+ -- The recognition by the binder is to ease the transition, and better deal
+ -- with some cases of inconsistent builds using incompatible versions of
+ -- the compiler and binder. The named notation is the current preferred
+ -- approach.
+
+ -- Note that R lines are generated using the information in unit Rident,
+ -- and intepreted by the binder using the information in System.Rident.
+ -- Normally these two units should be effectively identical. However in
+ -- some cases of inconsistent builds, they may be different. This may lead
+ -- to binder diagnostics, which can be suppressed using the -C switch for
+ -- the binder, which results in ignoring unrecognized restrictions in the
+ -- ali files.
+
+ -- ---------------------------------------
+ -- -- R Restrictions (Positional Form) --
+ -- ---------------------------------------
+
-- The first R line records the status of restrictions generated by pragma
-- Restrictions encountered, as well as information on what the compiler
-- has been able to determine with respect to restrictions violations.
@@ -348,6 +370,74 @@
-- signal a fatal error if it is missing. This means that future
-- changes to the ALI file format must retain the R line.
+ -- ----------------------------------
+ -- -- R Restrictions (Named Form) --
+ -- ----------------------------------
+
+ -- The first R line for named form announces that named notation will be
+ -- used, and also assures that there is at least one R line present, which
+ -- makes parsing of ali files simpler. A blank line preceds the RN line.
+
+ -- RN
+
+ -- In named notation, the restrictions are given as a series of lines, one
+ -- per retrictions that is specified or violated (no information is present
+ -- for restrictions that are not specified or violated). In the following
+ -- name is the name of the restriction in all upper case.
+
+ -- For boolean restrictions, we have only two possibilities. A restrictions
+ -- pragma is present, or a violation is detected:
+
+ -- RR name
+
+ -- A restriction pragma is present for the named boolean restriction.
+ -- No violations were detected by the compiler (or the unit in question
+ -- would have been found to be illegal).
+
+ -- RV name
+
+ -- No restriction pragma is present for the named boolean restriction.
+ -- However, the compiler did detect one or more violations of this
+ -- restriction, which may require a binder consistency check.
+
+ -- For the case of restrictions that take a parameter, we need both the
+ -- information from pragma if present, and the actual information about
+ -- what possible violations occur. For example, we can have a unit with
+ -- a pragma Restrictions (Max_Tasks => 4), where the compiler can detect
+ -- that there are exactly three tasks declared. Both of these pieces
+ -- of information must be passed to the binder. The parameter of 4 is
+ -- important in case the total number of tasks in the partition is greater
+ -- than 4. The parameter of 3 is important in case some other unit has a
+ -- restrictions pragma with Max_Tasks=>2.
+
+ -- RR name=N
+
+ -- A restriction pragma is present for the named restriction which is
+ -- one of the restrictions taking a parameter. The value N (a decimal
+ -- integer) is the value given in the restriction pragma.
+
+ -- RV name=N
+
+ -- A restriction pragma may or may not be present for the restriction
+ -- given by name (one of the restrictions taking a parameter). But in
+ -- either case, the compiler detected possible violations. N (a decimal
+ -- integer) is the maximum or total count of violations (depending
+ -- on the checking type) in all the units represented by the ali file).
+ -- The value here is known to be exact by the compiler and is in the
+ -- range of Natural. Note that if an RR line is present for the same
+ -- restriction, then the value in the RV line cannot exceed the value
+ -- in the RR line (since otherwise the compiler would have detected a
+ -- violation of the restriction).
+
+ -- RV name=N+
+
+ -- Similar to the above, but the compiler cannot determine the exact
+ -- count of violations, but it is at least N.
+
+ -- -------------------------------------------------
+ -- -- R Restrictions (No_Dependence Information) --
+ -- -------------------------------------------------
+
-- Subsequent R lines are present only if pragma Restriction No_Dependence
-- is used. There is one such line for each such pragma appearing in the
-- extended main unit. The format is:
===================================================================
@@ -135,7 +135,7 @@
-- d.O Dump internal SCO tables
-- d.P Previous (non-optimized) handling of length comparisons
-- d.Q
- -- d.R
+ -- d.R Restrictions in ali files in positional form
-- d.S Force Optimize_Alignment (Space)
-- d.T Force Optimize_Alignment (Time)
-- d.U Ignore indirect calls for static elaboration
@@ -642,6 +642,11 @@
-- This is there in case we find a situation where the optimization
-- malfunctions, to provide a work around.
+ -- d.R As documented in lib-writ.ads, restrictions in the ali file can
+ -- have two forms, positional and named. The named notation is the
+ -- current preferred form, but the use of this debug switch will force
+ -- the use of the obsolescent positional form.
+
-- d.S Force Optimize_Alignment (Space) mode as the default
-- d.T Force Optimize_Alignment (Time) mode as the default
===================================================================
@@ -6254,7 +6254,7 @@
-- Set Detect_Blocking mode
- -- Set required restrictions (see Rident for detailed list)
+ -- Set required restrictions (see System.Rident for detailed list)
-- Set the No_Dependence rules
-- No_Dependence => Ada.Asynchronous_Task_Control
===================================================================
@@ -135,7 +135,7 @@
Ignore_Errors : Boolean := False;
Directly_Scanned : Boolean := False) return ALI_Id
is
- P : Text_Ptr := T'First;
+ P : Text_Ptr := T'First;
Line : Logical_Line_Number := 1;
Id : ALI_Id;
C : Character;
@@ -1154,7 +1154,7 @@
C := Getc;
Check_Unknown_Line;
- -- Acquire first restrictions line
+ -- Loop to skip to first restrictions line
while C /= 'R' loop
if Ignore_Errors then
@@ -1169,10 +1169,15 @@
end if;
end loop;
+ -- Ignore all 'R' lines if that is required
+
if Ignore ('R') then
- Skip_Line;
+ while C = 'R' loop
+ Skip_Line;
+ C := Getc;
+ end loop;
- -- Process restrictions line
+ -- Here we process the restrictions lines (other than unit name cases)
else
Scan_Restrictions : declare
@@ -1182,16 +1187,191 @@
Bad_R_Line : exception;
-- Signal bad restrictions line (raised on unexpected character)
+ Typ : Character;
+ R : Restriction_Id;
+ N : Natural;
+
begin
- Checkc (' ');
- Skip_Space;
+ -- Named restriction case
- -- Acquire information for boolean restrictions
-
- for R in All_Boolean_Restrictions loop
+ if Nextc = 'N' then
+ Skip_Line;
C := Getc;
- case C is
+ -- Loop through RR and RV lines
+
+ while C = 'R' and then Nextc /= ' ' loop
+ Typ := Getc;
+ Checkc (' ');
+
+ -- Acquire restriction name
+
+ Name_Len := 0;
+ while not At_Eol and then Nextc /= '=' loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Getc;
+ end loop;
+
+ -- Now search list of restrictions to find match
+
+ declare
+ RN : String renames Name_Buffer (1 .. Name_Len);
+
+ begin
+ R := Restriction_Id'First;
+ while R < Not_A_Restriction_Id loop
+ if Restriction_Id'Image (R) = RN then
+ goto R_Found;
+ end if;
+
+ R := Restriction_Id'Succ (R);
+ end loop;
+
+ -- We don't recognize the restriction. This might be
+ -- thought of as an error, and it really is, but we
+ -- want to allow building with inconsistent versions
+ -- of the binder and ali files (see comments at the
+ -- start of package System.Rident), so we just ignore
+ -- this situation.
+
+ goto Done_With_Restriction_Line;
+ end;
+
+ <<R_Found>>
+
+ case R is
+
+ -- Boolean restriction case
+
+ when All_Boolean_Restrictions =>
+ case Typ is
+ when 'V' =>
+ ALIs.Table (Id).Restrictions.Violated (R) :=
+ True;
+ Cumulative_Restrictions.Violated (R) := True;
+
+ when 'R' =>
+ ALIs.Table (Id).Restrictions.Set (R) := True;
+ Cumulative_Restrictions.Set (R) := True;
+
+ when others =>
+ raise Bad_R_Line;
+ end case;
+
+ -- Parameter restriction case
+
+ when All_Parameter_Restrictions =>
+ if At_Eol or else Nextc /= '=' then
+ raise Bad_R_Line;
+ else
+ Skipc;
+ end if;
+
+ N := Natural (Get_Nat);
+
+ case Typ is
+
+ -- Restriction set
+
+ when 'R' =>
+ ALIs.Table (Id).Restrictions.Set (R) := True;
+ ALIs.Table (Id).Restrictions.Value (R) := N;
+
+ if Cumulative_Restrictions.Set (R) then
+ Cumulative_Restrictions.Value (R) :=
+ Integer'Min
+ (Cumulative_Restrictions.Value (R), N);
+ else
+ Cumulative_Restrictions.Set (R) := True;
+ Cumulative_Restrictions.Value (R) := N;
+ end if;
+
+ -- Restriction violated
+
+ when 'V' =>
+ ALIs.Table (Id).Restrictions.Violated (R) :=
+ True;
+ Cumulative_Restrictions.Violated (R) := True;
+ ALIs.Table (Id).Restrictions.Count (R) := N;
+
+ -- Checked Max_Parameter case
+
+ if R in Checked_Max_Parameter_Restrictions then
+ Cumulative_Restrictions.Count (R) :=
+ Integer'Max
+ (Cumulative_Restrictions.Count (R), N);
+
+ -- Other checked parameter cases
+
+ else
+ declare
+ pragma Unsuppress (Overflow_Check);
+
+ begin
+ Cumulative_Restrictions.Count (R) :=
+ Cumulative_Restrictions.Count (R) + N;
+
+ exception
+ when Constraint_Error =>
+
+ -- A constraint error comes from the
+ -- additionh. We reset to the maximum
+ -- and indicate that the real value is
+ -- now unknown.
+
+ Cumulative_Restrictions.Value (R) :=
+ Integer'Last;
+ Cumulative_Restrictions.Unknown (R) :=
+ True;
+ end;
+ end if;
+
+ -- Deal with + case
+
+ if Nextc = '+' then
+ Skipc;
+ ALIs.Table (Id).Restrictions.Unknown (R) :=
+ True;
+ Cumulative_Restrictions.Unknown (R) := True;
+ end if;
+
+ -- Other than 'R' or 'V'
+
+ when others =>
+ raise Bad_R_Line;
+ end case;
+
+ if not At_Eol then
+ raise Bad_R_Line;
+ end if;
+
+ -- Bizarre error case NOT_A_RESTRICTION
+
+ when Not_A_Restriction_Id =>
+ raise Bad_R_Line;
+ end case;
+
+ if not At_Eol then
+ raise Bad_R_Line;
+ end if;
+
+ <<Done_With_Restriction_Line>>
+ Skip_Line;
+ C := Getc;
+ end loop;
+
+ -- Positional restriction case
+
+ else
+ Checkc (' ');
+ Skip_Space;
+
+ -- Acquire information for boolean restrictions
+
+ for R in All_Boolean_Restrictions loop
+ C := Getc;
+
+ case C is
when 'v' =>
ALIs.Table (Id).Restrictions.Violated (R) := True;
Cumulative_Restrictions.Violated (R) := True;
@@ -1205,44 +1385,42 @@
when others =>
raise Bad_R_Line;
- end case;
- end loop;
+ end case;
+ end loop;
- -- Acquire information for parameter restrictions
+ -- Acquire information for parameter restrictions
- for RP in All_Parameter_Restrictions loop
+ for RP in All_Parameter_Restrictions loop
+ case Getc is
+ when 'n' =>
+ null;
- -- Acquire restrictions pragma information
+ when 'r' =>
+ ALIs.Table (Id).Restrictions.Set (RP) := True;
- case Getc is
- when 'n' =>
- null;
+ declare
+ N : constant Integer := Integer (Get_Nat);
+ begin
+ ALIs.Table (Id).Restrictions.Value (RP) := N;
- when 'r' =>
- ALIs.Table (Id).Restrictions.Set (RP) := True;
+ if Cumulative_Restrictions.Set (RP) then
+ Cumulative_Restrictions.Value (RP) :=
+ Integer'Min
+ (Cumulative_Restrictions.Value (RP), N);
+ else
+ Cumulative_Restrictions.Set (RP) := True;
+ Cumulative_Restrictions.Value (RP) := N;
+ end if;
+ end;
- declare
- N : constant Integer := Integer (Get_Nat);
- begin
- ALIs.Table (Id).Restrictions.Value (RP) := N;
+ when others =>
+ raise Bad_R_Line;
+ end case;
- if Cumulative_Restrictions.Set (RP) then
- Cumulative_Restrictions.Value (RP) :=
- Integer'Min
- (Cumulative_Restrictions.Value (RP), N);
- else
- Cumulative_Restrictions.Set (RP) := True;
- Cumulative_Restrictions.Value (RP) := N;
- end if;
- end;
+ -- Acquire restrictions violations information
- when others =>
- raise Bad_R_Line;
- end case;
+ case Getc is
- -- Acquire restrictions violations information
-
- case Getc is
when 'n' =>
null;
@@ -1252,7 +1430,6 @@
declare
N : constant Integer := Integer (Get_Nat);
- pragma Unsuppress (Overflow_Check);
begin
ALIs.Table (Id).Restrictions.Count (RP) := N;
@@ -1261,34 +1438,47 @@
Cumulative_Restrictions.Count (RP) :=
Integer'Max
(Cumulative_Restrictions.Count (RP), N);
+
else
- Cumulative_Restrictions.Count (RP) :=
- Cumulative_Restrictions.Count (RP) + N;
- end if;
+ declare
+ pragma Unsuppress (Overflow_Check);
- exception
- when Constraint_Error =>
+ begin
+ Cumulative_Restrictions.Count (RP) :=
+ Cumulative_Restrictions.Count (RP) + N;
- -- A constraint error comes from the addition in
- -- the else branch. We reset to the maximum and
- -- indicate that the real value is now unknown.
+ exception
+ when Constraint_Error =>
- Cumulative_Restrictions.Value (RP) := Integer'Last;
+ -- A constraint error comes from the add. We
+ -- reset to the maximum and indicate that the
+ -- real value is now unknown.
+
+ Cumulative_Restrictions.Value (RP) :=
+ Integer'Last;
+ Cumulative_Restrictions.Unknown (RP) := True;
+ end;
+ end if;
+
+ if Nextc = '+' then
+ Skipc;
+ ALIs.Table (Id).Restrictions.Unknown (RP) := True;
Cumulative_Restrictions.Unknown (RP) := True;
+ end if;
end;
- if Nextc = '+' then
- Skipc;
- ALIs.Table (Id).Restrictions.Unknown (RP) := True;
- Cumulative_Restrictions.Unknown (RP) := True;
- end if;
-
when others =>
raise Bad_R_Line;
- end case;
- end loop;
+ end case;
+ end loop;
- Skip_Eol;
+ if not At_Eol then
+ raise Bad_R_Line;
+ else
+ Skip_Line;
+ C := Getc;
+ end if;
+ end if;
-- Here if error during scanning of restrictions line
@@ -1296,25 +1486,29 @@
when Bad_R_Line =>
-- In Ignore_Errors mode, undo any changes to restrictions
- -- from this unit, and continue on.
+ -- from this unit, and continue on, skipping remaining R
+ -- lines for this unit.
if Ignore_Errors then
Cumulative_Restrictions := Save_R;
ALIs.Table (Id).Restrictions := No_Restrictions;
- Skip_Eol;
+ loop
+ Skip_Eol;
+ C := Getc;
+ exit when C /= 'R';
+ end loop;
+
-- In normal mode, this is a fatal error
else
Fatal_Error;
end if;
-
end Scan_Restrictions;
end if;
-- Acquire additional restrictions (No_Dependence) lines if present
- C := Getc;
while C = 'R' loop
if Ignore ('R') then
Skip_Line;
===================================================================
@@ -541,10 +541,10 @@
then
null;
- -- Here if restriction set, check for violation (either this is a
- -- Boolean restriction, or a parameter restriction with a value of
- -- zero and an unknown count, or a parameter restriction with a
- -- known value that exceeds the restriction count).
+ -- Here if restriction set, check for violation (this is a Boolean
+ -- restriction, or a parameter restriction with a value of zero and an
+ -- unknown count, or a parameter restriction with a known value that
+ -- exceeds the restriction count).
elsif R in All_Boolean_Restrictions
or else (Restrictions.Unknown (R)
@@ -768,7 +768,7 @@
----------------------------------
-- Note: body of this function must be coordinated with list of
- -- renaming declarations in Rident.
+ -- renaming declarations in System.Rident.
function Process_Restriction_Synonyms (N : Node_Id) return Name_Id
is
===================================================================
@@ -332,10 +332,10 @@
-- exception propagation is activated.
function Process_Restriction_Synonyms (N : Node_Id) return Name_Id;
- -- Id is a node whose Chars field contains the name of a restriction. If it
- -- is one of synonyms that we allow for historical purposes (for list see
- -- Rident), then the proper official name is returned. Otherwise the Chars
- -- field of the argument is returned unchanged.
+ -- Id is a node whose Chars field contains the name of a restriction.
+ -- If it is one of synonyms that we allow for historical purposes (for
+ -- list see System.Rident), then the proper official name is returned.
+ -- Otherwise the Chars field of the argument is returned unchanged.
function Restriction_Active (R : All_Restrictions) return Boolean;
pragma Inline (Restriction_Active);
===================================================================
@@ -30,18 +30,45 @@
------------------------------------------------------------------------------
-- This package defines the set of restriction identifiers. It is a generic
+-- package that is instantiated by the compiler/binder in package Rident, and
+-- is instantiated in package System.Restrictions for use at run-time.
-- The reason that we make this a generic package is so that in the case of
+-- the instantiation in Rident for use at compile time and bind time, we can
+-- generate normal image tables for the enumeration types, which are needed
+-- for diagnostic and informational messages. At run-time we really do not
+-- want to waste the space for these image tables, and they are not needed,
+-- so we can do the instantiation under control of Discard_Names to remove
+-- the tables.
+---------------------------------------------------
+-- Note On Compile/Run-Time Consistency Checking --
+---------------------------------------------------
+
+-- This unit is with'ed by the run-time (to make System.Restrictions which is
+-- used for run-time access to restriction information), by the compiler (to
+-- determine what restrictions are implemented and what their category is) and
+-- by the binder (in processing ali files, and generating the information used
+-- at run-time to access restriction information).
+
+-- Normally the version of System.Rident referenced in all three contexts
+-- should be the same. However, problems could arise in certain inconsistent
+-- builds that used inconsistent versions of the compiler and run-time. This
+-- sort of thing is not strictly correct, but it does arise when short-cuts
+-- are taken in build procedures.
+
+-- Previously, this kind of inconsistency could cause a significant problem.
+-- If versions of System.Rident accessed by the compiler and binder differed,
+-- then the binder could fail to recognize the R (restrictions line) in the
+-- ali file, leading to bind errors when restrictions were added or removed.
+
+-- The latest implementation avoids both this problem by using a named
+-- scheme for recording restrictions, rather than a positional scheme which
+-- fails completely if restrictions are added or subtracted. Now the worst
+-- that happens at bind time in incosistent builds is that unrecognized
+-- restrictions are ignored, and the consistency checking for restrictions
+-- might be incomplete, which is no big deal.
+
pragma Compiler_Unit;
generic
===================================================================
@@ -34,416 +34,16 @@
-- it can be used by the binder without dragging in unneeded compiler
-- packages.
-package Rident is
+-- Note: the actual definitions of the types are in package System.Rident,
+-- and this package is merely an instantiation of that package. The point
+-- of this level of generic indirection is to allow the compile time use
+-- to have the image tables available (this package is not compiled with
+-- Discard_Names), while at run-time we do not want those image tables.
- -- The following enumeration type defines the set of restriction
- -- identifiers that are implemented in GNAT.
+-- Rather than have clients instantiate System.Rident directly, we have the
+-- single instantiation here at the library level, which means that we only
+-- have one copy of the image tables
- -- To add a new restriction identifier, add an entry with the name to be
- -- used in the pragma, and add calls to the Restrict.Check_Restriction
- -- routine as appropriate.
+with System.Rident;
- type Restriction_Id is
-
- -- The following cases are checked for consistency in the binder. The
- -- binder will check that every unit either has the restriction set, or
- -- does not violate the restriction.
-
- (Simple_Barriers, -- GNAT (Ravenscar)
- No_Abort_Statements, -- (RM D.7(5), H.4(3))
- No_Access_Subprograms, -- (RM H.4(17))
- No_Allocators, -- (RM H.4(7))
- No_Allocators_After_Elaboration, -- Ada 2012 (RM D.7(19.1/2))
- No_Anonymous_Allocators, -- Ada 2012 (RM H.4(8/1))
- No_Asynchronous_Control, -- (RM D.7(10))
- No_Calendar, -- GNAT
- No_Default_Stream_Attributes, -- Ada 2012 (RM 13.12.1(4/2))
- No_Delay, -- (RM H.4(21))
- No_Direct_Boolean_Operators, -- GNAT
- No_Dispatch, -- (RM H.4(19))
- No_Dispatching_Calls, -- GNAT
- No_Dynamic_Attachment, -- GNAT
- No_Dynamic_Priorities, -- (RM D.9(9))
- No_Enumeration_Maps, -- GNAT
- No_Entry_Calls_In_Elaboration_Code, -- GNAT
- No_Entry_Queue, -- GNAT (Ravenscar)
- No_Exception_Handlers, -- GNAT
- No_Exception_Propagation, -- GNAT
- No_Exception_Registration, -- GNAT
- No_Exceptions, -- (RM H.4(12))
- No_Finalization, -- GNAT
- No_Fixed_Point, -- (RM H.4(15))
- No_Floating_Point, -- (RM H.4(14))
- No_IO, -- (RM H.4(20))
- No_Implicit_Conditionals, -- GNAT
- No_Implicit_Dynamic_Code, -- GNAT
- No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3))
- No_Implicit_Loops, -- GNAT
- No_Initialize_Scalars, -- GNAT
- No_Local_Allocators, -- (RM H.4(8))
- No_Local_Timing_Events, -- (RM D.7(10.2/2))
- No_Local_Protected_Objects, -- GNAT
- No_Nested_Finalization, -- (RM D.7(4))
- No_Protected_Type_Allocators, -- GNAT
- No_Protected_Types, -- (RM H.4(5))
- No_Recursion, -- (RM H.4(22))
- No_Reentrancy, -- (RM H.4(23))
- No_Relative_Delay, -- GNAT (Ravenscar)
- No_Requeue_Statements, -- GNAT
- No_Secondary_Stack, -- GNAT
- No_Select_Statements, -- GNAT (Ravenscar)
- No_Specific_Termination_Handlers, -- (RM D.7(10.7/2))
- No_Standard_Storage_Pools, -- GNAT
- No_Stream_Optimizations, -- GNAT
- No_Streams, -- GNAT
- No_Task_Allocators, -- (RM D.7(7))
- No_Task_Attributes_Package, -- GNAT
- No_Task_Hierarchy, -- (RM D.7(3), H.4(3))
- No_Task_Termination, -- GNAT (Ravenscar)
- No_Tasking, -- GNAT
- No_Terminate_Alternatives, -- (RM D.7(6))
- No_Unchecked_Access, -- (RM H.4(18))
- No_Unchecked_Conversion, -- (RM H.4(16))
- No_Unchecked_Deallocation, -- (RM H.4(9))
- Static_Priorities, -- GNAT
- Static_Storage_Size, -- GNAT
-
- -- The following require consistency checking with special rules. See
- -- individual routines in unit Bcheck for details of what is required.
-
- No_Default_Initialization, -- GNAT
-
- -- The following cases do not require consistency checking and if used
- -- as a configuration pragma within a specific unit, apply only to that
- -- unit (e.g. if used in the package spec, do not apply to the body)
-
- -- Note: No_Elaboration_Code is handled specially. Like the other
- -- non-partition-wide restrictions, it can only be set in a unit that
- -- is part of the extended main source unit (body/spec/subunits). But
- -- it is sticky, in that if it is found anywhere within any of these
- -- units, it applies to all units in this extended main source.
-
- Immediate_Reclamation, -- (RM H.4(10))
- No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241
- No_Implementation_Attributes, -- Ada 2005 AI-257
- No_Implementation_Identifiers, -- Ada 2012 AI-246
- No_Implementation_Pragmas, -- Ada 2005 AI-257
- No_Implementation_Restrictions, -- GNAT
- No_Implementation_Units, -- Ada 2012 AI-242
- No_Implicit_Aliasing, -- GNAT
- No_Elaboration_Code, -- GNAT
- No_Obsolescent_Features, -- Ada 2005 AI-368
- No_Wide_Characters, -- GNAT
- SPARK, -- GNAT
-
- -- The following cases require a parameter value
-
- -- The following entries are fully checked at compile/bind time, which
- -- means that the compiler can in general tell the minimum value which
- -- could be used with a restrictions pragma. The binder can deduce the
- -- appropriate minimum value for the partition by taking the maximum
- -- value required by any unit.
-
- Max_Protected_Entries, -- (RM D.7(14))
- Max_Select_Alternatives, -- (RM D.7(12))
- Max_Task_Entries, -- (RM D.7(13), H.4(3))
-
- -- The following entries are also fully checked at compile/bind time,
- -- and the compiler can also at least in some cases tell the minimum
- -- value which could be used with a restriction pragma. The difference
- -- is that the contributions are additive, so the binder deduces this
- -- value by adding the unit contributions.
-
- Max_Tasks, -- (RM D.7(19), H.4(3))
-
- -- The following entries are checked at compile time only for zero/
- -- nonzero entries. This means that the compiler can tell at compile
- -- time if a restriction value of zero is (would be) violated, but that
- -- the compiler cannot distinguish between different non-zero values.
-
- Max_Asynchronous_Select_Nesting, -- (RM D.7(18), H.4(3))
- Max_Entry_Queue_Length, -- GNAT
-
- -- The remaining entries are not checked at compile/bind time
-
- Max_Storage_At_Blocking, -- (RM D.7(17))
-
- Not_A_Restriction_Id);
-
- -- Synonyms permitted for historical purposes of compatibility.
- -- Must be coordinated with Restrict.Process_Restriction_Synonym.
-
- Boolean_Entry_Barriers : Restriction_Id renames Simple_Barriers;
- Max_Entry_Queue_Depth : Restriction_Id renames Max_Entry_Queue_Length;
- No_Dynamic_Interrupts : Restriction_Id renames No_Dynamic_Attachment;
- No_Requeue : Restriction_Id renames No_Requeue_Statements;
- No_Task_Attributes : Restriction_Id renames No_Task_Attributes_Package;
-
- subtype All_Restrictions is Restriction_Id range
- Simple_Barriers .. Max_Storage_At_Blocking;
- -- All restrictions (excluding only Not_A_Restriction_Id)
-
- subtype All_Boolean_Restrictions is Restriction_Id range
- Simple_Barriers .. SPARK;
- -- All restrictions which do not take a parameter
-
- subtype Partition_Boolean_Restrictions is All_Boolean_Restrictions range
- Simple_Barriers .. Static_Storage_Size;
- -- Boolean restrictions that are checked for partition consistency.
- -- Note that all parameter restrictions are checked for partition
- -- consistency by default, so this distinction is only needed in the
- -- case of Boolean restrictions.
-
- subtype Cunit_Boolean_Restrictions is All_Boolean_Restrictions range
- Immediate_Reclamation .. SPARK;
- -- Boolean restrictions that are not checked for partition consistency
- -- and that thus apply only to the current unit. Note that for these
- -- restrictions, the compiler does not apply restrictions found in
- -- with'ed units, parent specs etc. to the main unit, and vice versa.
-
- subtype All_Parameter_Restrictions is
- Restriction_Id range
- Max_Protected_Entries .. Max_Storage_At_Blocking;
- -- All restrictions that take a parameter
-
- subtype Checked_Parameter_Restrictions is
- All_Parameter_Restrictions range
- Max_Protected_Entries .. Max_Entry_Queue_Length;
- -- These are the parameter restrictions that can be at least partially
- -- checked at compile/binder time. Minimally, the compiler can detect
- -- violations of a restriction pragma with a value of zero reliably.
-
- subtype Checked_Max_Parameter_Restrictions is
- Checked_Parameter_Restrictions range
- Max_Protected_Entries .. Max_Task_Entries;
- -- Restrictions with parameters that can be checked in some cases by
- -- maximizing among statically detected instances where the compiler
- -- can determine the count.
-
- subtype Checked_Add_Parameter_Restrictions is
- Checked_Parameter_Restrictions range
- Max_Tasks .. Max_Tasks;
- -- Restrictions with parameters that can be checked in some cases by
- -- summing the statically detected instances where the compiler can
- -- determine the count.
-
- subtype Checked_Val_Parameter_Restrictions is
- Checked_Parameter_Restrictions range
- Max_Protected_Entries .. Max_Tasks;
- -- Restrictions with parameter where the count is known at least in some
- -- cases by the compiler/binder.
-
- subtype Checked_Zero_Parameter_Restrictions is
- Checked_Parameter_Restrictions range
- Max_Asynchronous_Select_Nesting .. Max_Entry_Queue_Length;
- -- Restrictions with parameters where the compiler can detect the use of
- -- the feature, and hence violations of a restriction specifying a value
- -- of zero, but cannot detect specific values other than zero/nonzero.
-
- subtype Unchecked_Parameter_Restrictions is
- All_Parameter_Restrictions range
- Max_Storage_At_Blocking .. Max_Storage_At_Blocking;
- -- Restrictions with parameters where the compiler cannot ever detect
- -- corresponding compile time usage, so the binder and compiler never
- -- detect violations of any restriction.
-
- -------------------------------------
- -- Restriction Status Declarations --
- -------------------------------------
-
- -- The following declarations are used to record the current status or
- -- restrictions (for the current unit, or related units, at compile time,
- -- and for all units in a partition at bind time or run time).
-
- type Restriction_Flags is array (All_Restrictions) of Boolean;
- type Restriction_Values is array (All_Parameter_Restrictions) of Natural;
- type Parameter_Flags is array (All_Parameter_Restrictions) of Boolean;
-
- type Restrictions_Info is record
- Set : Restriction_Flags;
- -- An entry is True in the Set array if a restrictions pragma has been
- -- encountered for the given restriction. If the value is True for a
- -- parameter restriction, then the corresponding entry in the Value
- -- array gives the minimum value encountered for any such restriction.
-
- Value : Restriction_Values;
- -- If the entry for a parameter restriction in Set is True (i.e. a
- -- restrictions pragma for the restriction has been encountered), then
- -- the corresponding entry in the Value array is the minimum value
- -- specified by any such restrictions pragma. Note that a restrictions
- -- pragma specifying a value greater than Int'Last is simply ignored.
-
- Violated : Restriction_Flags;
- -- An entry is True in the violations array if the compiler has detected
- -- a violation of the restriction. For a parameter restriction, the
- -- Count and Unknown arrays have additional information.
-
- Count : Restriction_Values;
- -- If an entry for a parameter restriction is True in Violated, the
- -- corresponding entry in the Count array may record additional
- -- information. If the actual minimum count is known (by taking
- -- maximums, or sums, depending on the restriction), it will be
- -- recorded in this array. If not, then the value will remain zero.
- -- The value is also zero for a non-violated restriction.
-
- Unknown : Parameter_Flags;
- -- If an entry for a parameter restriction is True in Violated, the
- -- corresponding entry in the Unknown array may record additional
- -- information. If the actual count is not known by the compiler (but
- -- is known to be non-zero), then the entry in Unknown will be True.
- -- This indicates that the value in Count is not known to be exact,
- -- and the actual violation count may be higher.
-
- -- Note: If Violated (K) is True, then either Count (K) > 0 or
- -- Unknown (K) = True. It is possible for both these to be set.
- -- For example, if Count (K) = 3 and Unknown (K) is True, it means
- -- that the actual violation count is at least 3 but might be higher.
- end record;
-
- No_Restrictions : constant Restrictions_Info :=
- (Set => (others => False),
- Value => (others => 0),
- Violated => (others => False),
- Count => (others => 0),
- Unknown => (others => False));
- -- Used to initialize Restrictions_Info variables
-
- ----------------------------------
- -- Profile Definitions and Data --
- ----------------------------------
-
- -- Note: to add a profile, modify the following declarations appropriately,
- -- add Name_xxx to Snames, and add a branch to the conditions for pragmas
- -- Profile and Profile_Warnings in the body of Sem_Prag.
-
- type Profile_Name is
- (No_Profile,
- No_Implementation_Extensions,
- Ravenscar,
- Restricted);
- -- Names of recognized profiles. No_Profile is used to indicate that a
- -- restriction came from pragma Restrictions[_Warning], as opposed to
- -- pragma Profile[_Warning].
-
- subtype Profile_Name_Actual is Profile_Name
- range No_Implementation_Extensions .. Restricted;
- -- Actual used profile names
-
- type Profile_Data is record
- Set : Restriction_Flags;
- -- Set to True if given restriction must be set for the profile, and
- -- False if it need not be set (False does not mean that it must not be
- -- set, just that it need not be set). If the flag is True for a
- -- parameter restriction, then the Value array gives the maximum value
- -- permitted by the profile.
-
- Value : Restriction_Values;
- -- An entry in this array is meaningful only if the corresponding flag
- -- in Set is True. In that case, the value in this array is the maximum
- -- value of the parameter permitted by the profile.
- end record;
-
- Profile_Info : constant array (Profile_Name_Actual) of Profile_Data :=
-
- (No_Implementation_Extensions =>
- -- Restrictions for Restricted profile
-
- (Set =>
- (No_Implementation_Aspect_Specifications => True,
- No_Implementation_Attributes => True,
- No_Implementation_Identifiers => True,
- No_Implementation_Pragmas => True,
- No_Implementation_Units => True,
- others => False),
-
- -- Value settings for Restricted profile (none
-
- Value =>
- (others => 0)),
-
- -- Restricted Profile
-
- Restricted =>
-
- -- Restrictions for Restricted profile
-
- (Set =>
- (No_Abort_Statements => True,
- No_Asynchronous_Control => True,
- No_Dynamic_Attachment => True,
- No_Dynamic_Priorities => True,
- No_Entry_Queue => True,
- No_Local_Protected_Objects => True,
- No_Protected_Type_Allocators => True,
- No_Requeue_Statements => True,
- No_Task_Allocators => True,
- No_Task_Attributes_Package => True,
- No_Task_Hierarchy => True,
- No_Terminate_Alternatives => True,
- Max_Asynchronous_Select_Nesting => True,
- Max_Protected_Entries => True,
- Max_Select_Alternatives => True,
- Max_Task_Entries => True,
- others => False),
-
- -- Value settings for Restricted profile
-
- Value =>
- (Max_Asynchronous_Select_Nesting => 0,
- Max_Protected_Entries => 1,
- Max_Select_Alternatives => 0,
- Max_Task_Entries => 0,
- others => 0)),
-
- -- Ravenscar Profile
-
- -- Note: the table entries here only represent the
- -- required restriction profile for Ravenscar. The
- -- full Ravenscar profile also requires:
-
- -- pragma Dispatching_Policy (FIFO_Within_Priorities);
- -- pragma Locking_Policy (Ceiling_Locking);
- -- pragma Detect_Blocking
-
- Ravenscar =>
-
- -- Restrictions for Ravenscar = Restricted profile ..
-
- (Set =>
- (No_Abort_Statements => True,
- No_Asynchronous_Control => True,
- No_Dynamic_Attachment => True,
- No_Dynamic_Priorities => True,
- No_Entry_Queue => True,
- No_Local_Protected_Objects => True,
- No_Protected_Type_Allocators => True,
- No_Requeue_Statements => True,
- No_Task_Allocators => True,
- No_Task_Attributes_Package => True,
- No_Task_Hierarchy => True,
- No_Terminate_Alternatives => True,
- Max_Asynchronous_Select_Nesting => True,
- Max_Protected_Entries => True,
- Max_Select_Alternatives => True,
- Max_Task_Entries => True,
-
- -- plus these additional restrictions:
-
- No_Calendar => True,
- No_Implicit_Heap_Allocations => True,
- No_Relative_Delay => True,
- No_Select_Statements => True,
- No_Task_Termination => True,
- Simple_Barriers => True,
- others => False),
-
- -- Value settings for Ravenscar (same as Restricted)
-
- Value =>
- (Max_Asynchronous_Select_Nesting => 0,
- Max_Protected_Entries => 1,
- Max_Select_Alternatives => 0,
- Max_Task_Entries => 0,
- others => 0)));
-
-end Rident;
+package Rident is new System.Rident;