-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Run_Time_Restrictions.Violated (No_Tasking);
end Tasking_Allowed;
--- Package elaboration code (acquire restrictions)
-
-begin
- Acquire_Restrictions : declare
-
- subtype Big_String is String (Positive);
- type Big_String_Ptr is access all Big_String;
-
- RString : Big_String_Ptr;
- pragma Import (C, RString, "__gl_restrictions");
-
- P : Natural := 1;
- -- Pointer to scan string
-
- C : Character;
- -- Next character from string
-
- function Get_Char return Character;
- -- Get next character from string
-
- function Get_Natural return Natural;
- -- Scan out natural value known to be in range, updating P past it
-
- --------------
- -- Get_Char --
- --------------
-
- function Get_Char return Character is
- begin
- P := P + 1;
- return RString (P - 1);
- end Get_Char;
-
- -----------------
- -- Get_Natural --
- -----------------
-
- function Get_Natural return Natural is
- N : Natural := 0;
-
- begin
- while RString (P) in '0' .. '9' loop
- N := N * 10 + (Character'Pos (Get_Char) - Character'Pos ('0'));
- end loop;
-
- return N;
- end Get_Natural;
-
- -- Start of processing for Acquire_Restrictions
-
- begin
- -- Acquire data corresponding to first R line
-
- for R in All_Boolean_Restrictions loop
- C := Get_Char;
-
- if C = 'v' then
- Run_Time_Restrictions.Violated (R) := True;
-
- elsif C = 'r' then
- Run_Time_Restrictions.Set (R) := True;
- end if;
- end loop;
-
- -- Acquire data corresponding to second R line
-
- for RP in All_Parameter_Restrictions loop
-
- -- Acquire restrictions pragma information
-
- if Get_Char = 'r' then
- Run_Time_Restrictions.Set (RP) := True;
- Run_Time_Restrictions.Value (RP) := Get_Natural;
- end if;
-
- -- Acquire restrictions violations information
-
- if Get_Char = 'v' then
- Run_Time_Restrictions.Violated (RP) := True;
- Run_Time_Restrictions.Count (RP) := Get_Natural;
-
- if RString (P) = '+' then
- Run_Time_Restrictions.Unknown (RP) := True;
- P := P + 1;
- end if;
- end if;
- end loop;
- end Acquire_Restrictions;
end System.Restrictions;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with System.Rident;
package System.Restrictions is
+ pragma Preelaborate;
pragma Discard_Names;
package Rident is new System.Rident;
Run_Time_Restrictions : Rident.Restrictions_Info;
+ -- Restrictions as set by the user, or detected by the binder.
+ -- Note that a restriction which is both Set and Violated at run-time means
+ -- that the violation was detected as part of the Ada run-time and not
+ -- as part of user code.
------------------
-- Subprograms --
function Tasking_Allowed return Boolean;
pragma Inline (Tasking_Allowed);
-- Tests to see if tasking operations are allowed by the current
- -- restrictions settings. For taskikng to be allowed, No_Tasking
+ -- restrictions settings. For tasking to be allowed, No_Tasking
-- must be False, and Max_Tasks must not be set to zero.
end System.Restrictions;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
generic
package System.Rident is
+ pragma Preelaborate;
-- The following enumeration type defines the set of restriction
-- identifiers that are implemented in GNAT.
type Parameter_Flags is array (All_Parameter_Restrictions) of Boolean;
type Restrictions_Info is record
- Set : Restriction_Flags := (others => False);
+ 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
-- specified by any such restrictions pragma. Note that a restrictions
-- pragma specifying a value greater than Int'Last is simply ignored.
- Violated : Restriction_Flags := (others => False);
+ 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 := (others => 0);
+ 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.
- Unknown : Parameter_Flags := (others => False);
+ 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
-- 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 --
----------------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2006 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- must always be present in a build, even if no unit has a direct with
-- of this unit.
+with System.Restrictions;
+-- Referenced directly from the binder generated file.
+
pragma Warnings (On);
package body System.Standard_Library is