-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
Elmts_Initial : constant := 1_200; -- Elists
Elmts_Increment : constant := 100;
- Entity_Suppress_Initial : constant := 100; -- Sem
- Entity_Suppress_Increment : constant := 200;
-
Inlined_Bodies_Initial : constant := 50; -- Inline
Inlined_Bodies_Increment : constant := 200;
Inlined_Initial : constant := 100; -- Inline
Inlined_Increment : constant := 100;
+ In_Out_Warnings_Initial : constant := 100; -- Sem_Warn
+ In_Out_Warnings_Increment : constant := 100;
+
Interp_Map_Initial : constant := 200; -- Sem_Type
Interp_Map_Increment : constant := 100;
with Eval_Fat; use Eval_Fat;
with Freeze; use Freeze;
with Lib; use Lib;
-with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
-- routine. The Do_Static flag indicates that only a static check is
-- to be done.
- type Check_Type is (Access_Check, Division_Check);
+ type Check_Type is new Check_Id range Access_Check .. Division_Check;
function Check_Needed (Nod : Node_Id; Check : Check_Type) return Boolean;
-- This function is used to see if an access or division by zero check is
-- needed. The check is to be applied to a single variable appearing in the
("?specified address for& may be inconsistent with alignment ",
Aexp, E);
Error_Msg_FE
- ("\?program execution may be erroneous ('R'M 13.3(27))",
+ ("\?program execution may be erroneous (RM 13.3(27))",
Aexp, E);
end if;
end Compile_Time_Bad_Alignment;
- -- Start of processing for Apply_Address_Check
+ -- Start of processing for Apply_Address_Clause_Check
begin
-- First obtain expression from address clause
-- maximum alignment is one, since the check will always succeed.
-- Note: we do not check for checks suppressed here, since that check
- -- was done in Sem_Ch13 when the address clause was proceeds. We are
+ -- was done in Sem_Ch13 when the address clause was processed. We are
-- only called if checks were not suppressed. The reason for this is
-- that we have to delay the call to Apply_Alignment_Check till freeze
-- time (so that all types etc are elaborated), but we have to check
-- No checks necessary if expression statically null
- if Nkind (N) = N_Null then
+ if Known_Null (N) then
if Can_Never_Be_Null (Typ) then
Install_Null_Excluding_Check (N);
end if;
-- unconstrained subtype (through instantiation). If this is a
-- discriminated component assigned in the expansion of an aggregate
-- in an initialization, the check must be suppressed. This unusual
- -- situation requires a predicate of its own (see 7503-008).
+ -- situation requires a predicate of its own.
----------------------------------------
-- Is_Aliased_Unconstrained_Component --
-- incomplete, then the access value must be null and we suppress the
-- check.
- if Nkind (N) = N_Null then
+ if Known_Null (N) then
return;
elsif Is_Access_Type (S_Typ) then
-- to perform a range check in the floating-point domain instead, however:
-- (1) The bounds may not be known at compile time
- -- (2) The check must take into account possible rounding.
+ -- (2) The check must take into account rounding or truncation.
-- (3) The range of type I may not be exactly representable in F.
- -- (4) The end-points I'First - 0.5 and I'Last + 0.5 may or may
- -- not be in range, depending on the sign of I'First and I'Last.
+ -- (4) For the rounding case, The end-points I'First - 0.5 and
+ -- I'Last + 0.5 may or may not be in range, depending on the
+ -- sign of I'First and I'Last.
-- (5) X may be a NaN, which will fail any comparison
- -- The following steps take care of these issues converting X:
+ -- The following steps correctly convert X with rounding:
-- (1) If either I'First or I'Last is not known at compile time, use
-- I'Base instead of I in the next three steps and perform a
-- regular range check against I'Range after conversion.
-- (2) If I'First - 0.5 is representable in F then let Lo be that
-- value and define Lo_OK as (I'First > 0). Otherwise, let Lo be
- -- F'Machine (T) and let Lo_OK be (Lo >= I'First). In other words,
- -- take one of the closest floating-point numbers to T, and see if
- -- it is in range or not.
+ -- F'Machine (I'First) and let Lo_OK be (Lo >= I'First).
+ -- In other words, take one of the closest floating-point numbers
+ -- (which is an integer value) to I'First, and see if it is in
+ -- range or not.
-- (3) If I'Last + 0.5 is representable in F then let Hi be that value
-- and define Hi_OK as (I'Last < 0). Otherwise, let Hi be
- -- F'Rounding (T) and let Hi_OK be (Hi <= I'Last).
+ -- F'Machine (I'Last) and let Hi_OK be (Hi <= I'Last).
-- (4) Raise CE when (Lo_OK and X < Lo) or (not Lo_OK and X <= Lo)
-- or (Hi_OK and X > Hi) or (not Hi_OK and X >= Hi)
+ -- For the truncating case, replace steps (2) and (3) as follows:
+ -- (2) If I'First > 0, then let Lo be F'Pred (I'First) and let Lo_OK
+ -- be False. Otherwise, let Lo be F'Succ (I'First - 1) and let
+ -- Lo_OK be True.
+ -- (3) If I'Last < 0, then let Hi be F'Succ (I'Last) and let Hi_OK
+ -- be False. Otherwise let Hi be F'Pred (I'Last + 1) and let
+ -- Hi_OK be False
+
procedure Apply_Float_Conversion_Check
(Ck_Node : Node_Id;
Target_Typ : Entity_Id)
Target_Base : constant Entity_Id :=
Implementation_Base_Type (Target_Typ);
- Max_Bound : constant Uint := UI_Expon
- (Machine_Radix (Expr_Type),
- Machine_Mantissa (Expr_Type) - 1) - 1;
+ Par : constant Node_Id := Parent (Ck_Node);
+ pragma Assert (Nkind (Par) = N_Type_Conversion);
+ -- Parent of check node, must be a type conversion
+
+ Truncate : constant Boolean := Float_Truncate (Par);
+ Max_Bound : constant Uint :=
+ UI_Expon
+ (Machine_Radix (Expr_Type),
+ Machine_Mantissa (Expr_Type) - 1) - 1;
+
-- Largest bound, so bound plus or minus half is a machine number of F
Ifirst, Ilast : Uint;
-- to prevent overflow during conversion and then perform a
-- regular range check against the (dynamic) bounds.
- Par : constant Node_Id := Parent (Ck_Node);
-
pragma Assert (Target_Base /= Target_Typ);
- pragma Assert (Nkind (Par) = N_Type_Conversion);
Temp : constant Entity_Id :=
Make_Defining_Identifier (Loc,
-- Check against lower bound
- if abs (Ifirst) < Max_Bound then
+ if Truncate and then Ifirst > 0 then
+ Lo := Pred (Expr_Type, UR_From_Uint (Ifirst));
+ Lo_OK := False;
+
+ elsif Truncate then
+ Lo := Succ (Expr_Type, UR_From_Uint (Ifirst - 1));
+ Lo_OK := True;
+
+ elsif abs (Ifirst) < Max_Bound then
Lo := UR_From_Uint (Ifirst) - Ureal_Half;
Lo_OK := (Ifirst > 0);
+
else
Lo := Machine (Expr_Type, UR_From_Uint (Ifirst), Round_Even, Ck_Node);
Lo_OK := (Lo >= UR_From_Uint (Ifirst));
-- Check against higher bound
- if abs (Ilast) < Max_Bound then
+ if Truncate and then Ilast < 0 then
+ Hi := Succ (Expr_Type, UR_From_Uint (Ilast));
+ Lo_OK := False;
+
+ elsif Truncate then
+ Hi := Pred (Expr_Type, UR_From_Uint (Ilast + 1));
+ Hi_OK := True;
+
+ elsif abs (Ilast) < Max_Bound then
Hi := UR_From_Uint (Ilast) + Ureal_Half;
Hi_OK := (Ilast < 0);
else
-- Start of processing for Apply_Scalar_Range_Check
begin
- if Inside_A_Generic then
- return;
+ -- Return if check obviously not needed
- -- Return if check obviously not needed. Note that we do not check for
- -- the expander being inactive, since this routine does not insert any
- -- code, but it does generate useful warnings sometimes, which we would
- -- like even if we are in semantics only mode.
+ if
+ -- Not needed inside generic
- elsif Target_Typ = Any_Type
- or else not Is_Scalar_Type (Target_Typ)
- or else Raises_Constraint_Error (Expr)
+ Inside_A_Generic
+
+ -- Not needed if previous error
+
+ or else Target_Typ = Any_Type
+ or else Nkind (Expr) = N_Error
+
+ -- Not needed for non-scalar type
+
+ or else not Is_Scalar_Type (Target_Typ)
+
+ -- Not needed if we know node raises CE already
+
+ or else Raises_Constraint_Error (Expr)
then
return;
end if;
return True;
end if;
- -- Right operand of test mus be key value (zero or null)
+ -- Right operand of test must be key value (zero or null)
case Check is
when Access_Check =>
- if Nkind (R) /= N_Null then
+ if not Known_Null (R) then
return True;
end if;
then
return True;
end if;
+
+ when others =>
+ raise Program_Error;
end case;
-- Here we have the optimizable case, warn if not short-circuited
Error_Msg_N
("Constraint_Error may be raised (zero divide)?",
Parent (Nod));
+
+ when others =>
+ raise Program_Error;
end case;
if K = N_Op_And then
if K /= N_Function_Specification then
Expr := Expression (N);
- if Present (Expr)
- and then Nkind (Expr) = N_Null
- then
+ if Present (Expr) and then Known_Null (Expr) then
case K is
when N_Component_Declaration |
N_Discriminant_Specification =>
Apply_Compile_Time_Constraint_Error
(N => Expr,
- Msg => "(Ada 2005) NULL not allowed " &
+ Msg => "(Ada 2005) null not allowed " &
"in null-excluding components?",
Reason => CE_Null_Not_Allowed);
when N_Object_Declaration =>
Apply_Compile_Time_Constraint_Error
(N => Expr,
- Msg => "(Ada 2005) NULL not allowed " &
+ Msg => "(Ada 2005) null not allowed " &
"in null-excluding objects?",
Reason => CE_Null_Not_Allowed);
when N_Parameter_Specification =>
Apply_Compile_Time_Constraint_Error
(N => Expr,
- Msg => "(Ada 2005) NULL not allowed " &
+ Msg => "(Ada 2005) null not allowed " &
"in null-excluding formals?",
Reason => CE_Null_Not_Allowed);
Reason => Reason)));
Rewrite (N, New_Occurrence_Of (Tnn, Loc));
+
+ -- Set the type of N, because the declaration for Tnn might not
+ -- be analyzed yet, as is the case if N appears within a record
+ -- declaration, as a discriminant constraint or expression.
+
+ Set_Etype (N, Target_Base_Type);
end;
-- At this stage, we know that we have two scalar types, which are
end if;
end Generate_Range_Check;
+ ------------------
+ -- Get_Check_Id --
+ ------------------
+
+ function Get_Check_Id (N : Name_Id) return Check_Id is
+ begin
+ -- For standard check name, we can do a direct computation
+
+ if N in First_Check_Name .. Last_Check_Name then
+ return Check_Id (N - (First_Check_Name - 1));
+
+ -- For non-standard names added by pragma Check_Name, search table
+
+ else
+ for J in All_Checks + 1 .. Check_Names.Last loop
+ if Check_Names.Table (J) = N then
+ return J;
+ end if;
+ end loop;
+ end if;
+
+ -- No matching name found
+
+ return No_Check_Id;
+ end Get_Check_Id;
+
---------------------
-- Get_Discriminal --
---------------------
Sc : Entity_Id;
begin
- -- The entity E is the type of a private component of the protected
- -- type, or the type of a renaming of that component within a protected
- -- operation of that type.
-
- Sc := Scope (E);
-
- if Ekind (Sc) /= E_Protected_Type then
- Sc := Scope (Sc);
-
- if Ekind (Sc) /= E_Protected_Type then
- return Bound;
- end if;
- end if;
-
-- The bound can be a bona fide parameter of a protected operation,
-- rather than a prival encoded as an in-parameter.
return Bound;
end if;
+ -- Climb the scope stack looking for an enclosing protected type. If
+ -- we run out of scopes, return the bound itself.
+
+ Sc := Scope (E);
+ while Present (Sc) loop
+ if Sc = Standard_Standard then
+ return Bound;
+
+ elsif Ekind (Sc) = E_Protected_Type then
+ exit;
+ end if;
+
+ Sc := Scope (Sc);
+ end loop;
+
D := First_Discriminant (Sc);
+ while Present (D) loop
+ if Chars (D) = Chars (Bound) then
+ return New_Occurrence_Of (Discriminal (D), Loc);
+ end if;
- while Present (D)
- and then Chars (D) /= Chars (Bound)
- loop
Next_Discriminant (D);
end loop;
- return New_Occurrence_Of (Discriminal (D), Loc);
+ return Bound;
end Get_Discriminal;
+ ----------------------
+ -- Get_Range_Checks --
+ ----------------------
+
+ function Get_Range_Checks
+ (Ck_Node : Node_Id;
+ Target_Typ : Entity_Id;
+ Source_Typ : Entity_Id := Empty;
+ Warn_Node : Node_Id := Empty) return Check_Result
+ is
+ begin
+ return Selected_Range_Checks
+ (Ck_Node, Target_Typ, Source_Typ, Warn_Node);
+ end Get_Range_Checks;
+
------------------
-- Guard_Access --
------------------
for J in Determine_Range_Cache_N'Range loop
Determine_Range_Cache_N (J) := Empty;
end loop;
+
+ Check_Names.Init;
+
+ for J in Int range 1 .. All_Checks loop
+ Check_Names.Append (Name_Id (Int (First_Check_Name) + J - 1));
+ end loop;
end Initialize;
-------------------------
return;
end if;
+ -- No check needed for access to concurrent record types generated by
+ -- the expander. This is not just an optimization (though it does indeed
+ -- remove junk checks). It also avoids generation of junk warnings.
+
+ if Nkind (N) in N_Has_Chars
+ and then Chars (N) = Name_uObject
+ and then Is_Concurrent_Record_Type
+ (Directly_Designated_Type (Etype (N)))
+ then
+ return;
+ end if;
+
-- Otherwise install access check
Insert_Action (N,
return Scope_Suppress (Overflow_Check);
end if;
end Overflow_Checks_Suppressed;
-
- -----------------
- -- Range_Check --
- -----------------
-
- function Range_Check
- (Ck_Node : Node_Id;
- Target_Typ : Entity_Id;
- Source_Typ : Entity_Id := Empty;
- Warn_Node : Node_Id := Empty) return Check_Result
- is
- begin
- return Selected_Range_Checks
- (Ck_Node, Target_Typ, Source_Typ, Warn_Node);
- end Range_Check;
-
-----------------------------
-- Range_Checks_Suppressed --
-----------------------------
Next_Index (Indx_Type);
end loop;
- Get_Index_Bounds (Indx_Type, Lo, Hi);
+ Get_Index_Bounds (Indx_Type, Lo, Hi);
if Nkind (Lo) = N_Identifier
and then Ekind (Entity (Lo)) = E_In_Parameter
T_Typ := Designated_Type (T_Typ);
Do_Access := True;
- -- A simple optimization
+ -- A simple optimization for the null case
- if Nkind (Ck_Node) = N_Null then
+ if Known_Null (Ck_Node) then
return Ret_Result;
end if;
end if;
T_Typ := Designated_Type (T_Typ);
Do_Access := True;
- -- A simple optimization
+ -- A simple optimization for the null case
- if Nkind (Ck_Node) = N_Null then
+ if Known_Null (Ck_Node) then
return Ret_Result;
end if;
end if;
-- This always occurs whether checks are suppressed or not. Dynamic range
-- checks are, of course, not inserted if checks are suppressed.
-with Types; use Types;
-with Uintp; use Uintp;
+with Namet; use Namet;
+with Table;
+with Types; use Types;
+with Uintp; use Uintp;
package Checks is
-- values (i.e. the underlying integer value is used).
type Check_Result is private;
- -- Type used to return result of Range_Check call, for later use in
+ -- Type used to return result of Get_Range_Checks call, for later use in
-- call to Insert_Range_Checks procedure.
+ function Get_Range_Checks
+ (Ck_Node : Node_Id;
+ Target_Typ : Entity_Id;
+ Source_Typ : Entity_Id := Empty;
+ Warn_Node : Node_Id := Empty) return Check_Result;
+ -- Like Apply_Range_Check, except it does not modify anything. Instead
+ -- it returns an encapsulated result of the check operations for later
+ -- use in a call to Insert_Range_Checks. If Warn_Node is non-empty, its
+ -- Sloc is used, in the static case, for the generated warning or error.
+ -- Additionally, it is used rather than Expr (or Low/High_Bound of Expr)
+ -- in constructing the check.
+
procedure Append_Range_Checks
(Checks : Check_Result;
Stmts : List_Id;
Suppress_Typ : Entity_Id;
Static_Sloc : Source_Ptr;
Flag_Node : Node_Id);
- -- Called to append range checks as returned by a call to Range_Check.
+ -- Called to append range checks as returned by a call to Get_Range_Checks.
-- Stmts is a list to which either the dynamic check is appended or the
-- raise Constraint_Error statement is appended (for static checks).
-- Static_Sloc is the Sloc at which the raise CE node points, Flag_Node is
Static_Sloc : Source_Ptr := No_Location;
Flag_Node : Node_Id := Empty;
Do_Before : Boolean := False);
- -- Called to insert range checks as returned by a call to Range_Check.
+ -- Called to insert range checks as returned by a call to Get_Range_Checks.
-- Node is the node after which either the dynamic check is inserted or
-- the raise Constraint_Error statement is inserted (for static checks).
-- Suppress_Typ is the type to check to determine if checks are suppressed.
-- inserted after, if Do_Before is True, the check is inserted before
-- Node.
- function Range_Check
- (Ck_Node : Node_Id;
- Target_Typ : Entity_Id;
- Source_Typ : Entity_Id := Empty;
- Warn_Node : Node_Id := Empty)
- return Check_Result;
- -- Like Apply_Range_Check, except it does not modify anything. Instead
- -- it returns an encapsulated result of the check operations for later
- -- use in a call to Insert_Range_Checks. If Warn_Node is non-empty, its
- -- Sloc is used, in the static case, for the generated warning or error.
- -- Additionally, it is used rather than Expr (or Low/High_Bound of Expr)
- -- in constructing the check.
-
-----------------------
-- Expander Routines --
-----------------------
-- If N is an N_Range node, then Ensure_Valid is called on its bounds,
-- if validity checking of operands is enabled.
+ -----------------------------
+ -- Handling of Check Names --
+ -----------------------------
+
+ -- The following table contains Name_Id's for recognized checks. The first
+ -- entries (corresponding to the values of the subtype Predefined_Check_Id)
+ -- contain the Name_Id values for the checks that are predefined, including
+ -- All_Checks (see Types). Remaining entries are those that are introduced
+ -- by pragma Check_Names.
+
+ package Check_Names is new Table.Table (
+ Table_Component_Type => Name_Id,
+ Table_Index_Type => Check_Id,
+ Table_Low_Bound => 1,
+ Table_Initial => 30,
+ Table_Increment => 200,
+ Table_Name => "Name_Check_Names");
+
+ function Get_Check_Id (N : Name_Id) return Check_Id;
+ -- Function to search above table for matching name. If found returns the
+ -- corresponding Check_Id value in the range 1 .. Check_Name.Last. If not
+ -- found returns No_Check_Id.
+
private
type Check_Result is array (Positive range 1 .. 2) of Node_Id;
Lib.List;
end if;
- -- Output any messages for unreferenced entities
+ -- Output waiting warning messages
- Output_Unreferenced_Messages;
+ Sem_Warn.Output_Non_Modifed_In_Out_Warnings;
+ Sem_Warn.Output_Unreferenced_Messages;
Sem_Warn.Check_Unused_Withs;
end if;
end if;
-- set (that's why we can't simply use a FOR loop here).
J := 0;
-
while J <= Pending_Instantiations.Last
and then Serious_Errors_Detected = 0
loop
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- Frontend, and thus are not mutually recursive.
with Alloc;
+with Sem; use Sem;
with Table;
-with Types; use Types;
+with Types; use Types;
package Inline is
-- global data structure, and the bodies constructed by means of a separate
-- analysis and expansion step.
- -- See full description in body of Sem_Ch12 for details
+ -- See full description in body of Sem_Ch12 for more details
type Pending_Body_Info is record
Inst_Node : Node_Id;
-- The semantic unit within which the instantiation is found. Must
-- be restored when compiling the body, to insure that internal enti-
-- ties use the same counter and are unique over spec and body.
+
+ Scope_Suppress : Suppress_Array;
+ Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
+ -- Save suppress information at the point of instantiation. Used to
+ -- properly inherit check status active at this point (see RM 11.5
+ -- (7.2/2), AI95-00224-01):
+ --
+ -- "If a checking pragma applies to a generic instantiation, then the
+ -- checking pragma also applies to the instance. If a checking pragma
+ -- applies to a call to a subprogram that has a pragma Inline applied
+ -- to it, then the checking pragma also applies to the inlined
+ -- subprogram body".
+ --
+ -- This means we have to capture this information from the current scope
+ -- at the point of instantiation.
+
end record;
package Pending_Instantiations is new Table.Table (
-- --
------------------------------------------------------------------------------
--- This package contains host independent type definitions which are used
--- in more than one unit in the compiler. They are gathered here for easy
+-- This package contains host independent type definitions which are used in
+-- more than one unit in the compiler. They are gathered here for easy
-- reference, though in some cases the full description is found in the
--- relevant module which implements the definition. The main reason that
--- they are not in their "natural" specs is that this would cause a lot
--- of inter-spec dependencies, and in particular some awkward circular
--- dependencies would have to be dealt with.
+-- relevant module which implements the definition. The main reason that they
+-- are not in their "natural" specs is that this would cause a lot of inter-
+-- spec dependencies, and in particular some awkward circular dependencies
+-- would have to be dealt with.
-- WARNING: There is a C version of this package. Any changes to this source
-- file must be properly reflected in the C header file types.h declarations.
-- Line terminator characters (LF, VT, FF, CR)
--
-- This definition is dubious now that we have two more wide character
- -- sequences that constitute a line terminator. Every reference to
- -- this subtype needs checking to make sure the wide character case
- -- is handled appropriately. ???
+ -- sequences that constitute a line terminator. Every reference to this
+ -- subtype needs checking to make sure the wide character case is handled
+ -- appropriately. ???
subtype Upper_Half_Character is
Character range Character'Val (16#80#) .. Character'Val (16#FF#);
-- Types Used for Text Buffer Handling --
-----------------------------------------
- -- We can't use type String for text buffers, since we must use the
- -- standard 32-bit integer as an index value, since we count on all
- -- index values being the same size.
+ -- We can not use type String for text buffers, since we must use the
+ -- standard 32-bit integer as an index value, since we count on all index
+ -- values being the same size.
type Text_Ptr is new Int;
-- Type used for subscripts in text buffer
type Physical_Line_Number is range 1 .. Int'Last;
for Physical_Line_Number'Size use 32;
- -- Line number type, used for storing physical line numbers (i.e.
- -- line numbers in the physical file being compiled, unaffected by
- -- the presence of source reference pragmas.
+ -- Line number type, used for storing physical line numbers (i.e. line
+ -- numbers in the physical file being compiled, unaffected by the presence
+ -- of source reference pragmas.
type Column_Number is range 0 .. 32767;
for Column_Number'Size use 16;
subtype Source_Buffer is Text_Buffer;
-- Type used to store text of a source file . The buffer for the main
-- source (the source specified on the command line) has a lower bound
- -- starting at zero. Subsequent subsidiary sources have lower bounds
- -- which are one greater than the previous upper bound.
+ -- starting at zero. Subsequent subsidiary sources have lower bounds which
+ -- are one greater than the previous upper bound.
subtype Big_Source_Buffer is Text_Buffer (0 .. Text_Ptr'Last);
-- This is a virtual type used as the designated type of the access
-- type Source_Buffer_Ptr, see Osint.Read_Source_File for details.
type Source_Buffer_Ptr is access all Big_Source_Buffer;
- -- Pointer to source buffer. We use virtual origin addressing for
- -- source buffers, with thin pointers. The pointer points to a virtual
- -- instance of type Big_Source_Buffer, where the actual type is in fact
- -- of type Source_Buffer. The address is adjusted so that the virtual
- -- origin addressing works correctly. See Osint.Read_Source_Buffer for
- -- further details.
+ -- Pointer to source buffer. We use virtual origin addressing for source
+ -- buffers, with thin pointers. The pointer points to a virtual instance
+ -- of type Big_Source_Buffer, where the actual type is in fact of type
+ -- Source_Buffer. The address is adjusted so that the virtual origin
+ -- addressing works correctly. See Osint.Read_Source_Buffer for further
+ -- details.
subtype Source_Ptr is Text_Ptr;
-- Type used to represent a source location, which is a subscript of a
-- mode and the corresponding source line in -gnatD mode).
Standard_Location : constant Source_Ptr := -2;
- -- Used for all nodes in the representation of package Standard other
- -- than nodes representing the contents of Standard.ASCII. Note that
- -- testing for <= Standard_Location tests for both Standard_Location
- -- and for Standard_ASCII_Location.
+ -- Used for all nodes in the representation of package Standard other than
+ -- nodes representing the contents of Standard.ASCII. Note that testing for
+ -- a value being <= Standard_Location tests for both Standard_Location and
+ -- for Standard_ASCII_Location.
Standard_ASCII_Location : constant Source_Ptr := -3;
-- Used for all nodes in the presentation of package Standard.ASCII
-- List_Id and Node_Id values (see further description below).
List_High_Bound : constant := 0;
- -- Maximum List_Id subscript value. This allows up to 100 million list
- -- Id values, which is in practice infinite, and there is no need to
- -- check the range. The range overlaps the node range by one element
- -- (with value zero), which is used both for the Empty node, and for
- -- indicating no list. The fact that the same value is used is convenient
- -- because it means that the default value of Empty applies to both nodes
- -- and lists, and also is more efficient to test for.
+ -- Maximum List_Id subscript value. This allows up to 100 million list Id
+ -- values, which is in practice infinite, and there is no need to check the
+ -- range. The range overlaps the node range by one element (with value
+ -- zero), which is used both for the Empty node, and for indicating no
+ -- list. The fact that the same value is used is convenient because it
+ -- means that the default value of Empty applies to both nodes and lists,
+ -- and also is more efficient to test for.
Node_Low_Bound : constant := 0;
-- The tree Id values start at zero, because we use zero for Empty (to
------------------------------
-- List_Id values are used to identify node lists in the tree. They are
- -- subscripts into the Lists table declared in package Tree. Note that
- -- the special value Error_List is a subscript in this table, but the
- -- value No_List is *not* a valid subscript, and any attempt to apply
- -- list operations to No_List will cause a (detected) error.
+ -- subscripts into the Lists table declared in package Tree. Note that the
+ -- special value Error_List is a subscript in this table, but the value
+ -- No_List is *not* a valid subscript, and any attempt to apply list
+ -- operations to No_List will cause a (detected) error.
type List_Id is range List_Low_Bound .. List_High_Bound;
-- Type used to identify a node list
-- Types for Elists Package --
------------------------------
- -- Element list Id values are used to identify element lists stored in
- -- the tree (see package Tree for further details). They are formed by
- -- adding a bias (Element_List_Bias) to subscript values in the same
- -- array that is used for node list headers.
+ -- Element list Id values are used to identify element lists stored in the
+ -- tree (see package Tree for further details). They are formed by adding a
+ -- bias (Element_List_Bias) to subscript values in the same array that is
+ -- used for node list headers.
type Elist_Id is range Elist_Low_Bound .. Elist_High_Bound;
-- Type used to identify an element list (Elist header table subscript)
-- Types for Stringt Package --
-------------------------------
- -- String_Id values are used to identify entries in the strings table.
- -- They are subscripts into the strings table defined in package Strings.
+ -- String_Id values are used to identify entries in the strings table. They
+ -- are subscripts into the strings table defined in package Strings.
-- Note that with only a few exceptions, which are clearly documented, the
-- type String_Id should be regarded as a private type. In particular it is
-- Character Code Type --
-------------------------
- -- The type Char is used for character data internally in the compiler,
- -- but character codes in the source are represented by the Char_Code
- -- type. Each character literal in the source is interpreted as being one
- -- of the 16#8000_0000 possible Wide_Wide_Character codes, and a unique
- -- Integer Value is assigned, corresponding to the UTF_32 value, which
- -- also correspondds to the POS value in the Wide_Wide_Character type,
- -- and also corresponds to the POS value in the Wide_Character and
- -- Character types for values that are in appropriate range. String
- -- literals are similarly interpreted as a sequence of such codes.
+ -- The type Char is used for character data internally in the compiler, but
+ -- character codes in the source are represented by the Char_Code type.
+ -- Each character literal in the source is interpreted as being one of the
+ -- 16#8000_0000 possible Wide_Wide_Character codes, and a unique Integer
+ -- Value is assigned, corresponding to the UTF_32 value, which also
+ -- correspondds to the POS value in the Wide_Wide_Character type, and also
+ -- corresponds to the POS value in the Wide_Character and Character types
+ -- for values that are in appropriate range. String literals are similarly
+ -- interpreted as a sequence of such codes.
type Char_Code_Base is mod 2 ** 32;
for Char_Code_Base'Size use 32;
pragma Inline (Get_Character);
-- For a character C that is in Character range (see above function), this
-- function returns the corresponding Character value. It is an error to
- -- call Get_Character if C is not in C haracter range
+ -- call Get_Character if C is not in Character range.
function Get_Wide_Character (C : Char_Code) return Wide_Character;
-- For a character C that is in Wide_Character range (see above function),
-- Type used to represent time stamp
Empty_Time_Stamp : constant Time_Stamp_Type := (others => ' ');
- -- Type used to represent an empty or missing time stamp. Looks less
- -- than any real time stamp if two time stamps are compared. Note that
- -- although this is not a private type, clients should not rely on the
- -- exact way in which this string is represented, and instead should
- -- use the subprograms below.
+ -- Value representing an empty or missing time stamp. Looks less than any
+ -- real time stamp if two time stamps are compared. Note that although this
+ -- is not private, clients should not rely on the exact way in which this
+ -- string is represented, and instead should use the subprograms below.
Dummy_Time_Stamp : constant Time_Stamp_Type := (others => '0');
-- This is used for dummy time stamp values used in the D lines for
function ">=" (Left, Right : Time_Stamp_Type) return Boolean;
function "<" (Left, Right : Time_Stamp_Type) return Boolean;
function ">" (Left, Right : Time_Stamp_Type) return Boolean;
- -- Comparison functions on time stamps. Note that two time stamps
- -- are defined as being equal if they have the same day/month/year
- -- and the hour/minutes/seconds values are within 2 seconds of one
- -- another. This deals with rounding effects in library file time
- -- stamps caused by copying operations during installation. We have
- -- particularly noticed that WinNT seems susceptible to such changes.
- -- Note: the Empty_Time_Stamp value looks equal to itself, and less
- -- than any non-empty time stamp value.
+ -- Comparison functions on time stamps. Note that two time stamps are
+ -- defined as being equal if they have the same day/month/year and the
+ -- hour/minutes/seconds values are within 2 seconds of one another. This
+ -- deals with rounding effects in library file time stamps caused by
+ -- copying operations during installation. We have particularly noticed
+ -- that WinNT seems susceptible to such changes.
+ --
+ -- Note : the Empty_Time_Stamp value looks equal to itself, and less than
+ -- any non-empty time stamp value.
procedure Split_Time_Stamp
(TS : Time_Stamp_Type;
-- Types used for Pragma Suppress Management --
-----------------------------------------------
- type Check_Id is
- (Access_Check,
- Accessibility_Check,
- Alignment_Check,
- Discriminant_Check,
- Division_Check,
- Elaboration_Check,
- Index_Check,
- Length_Check,
- Overflow_Check,
- Range_Check,
- Storage_Check,
- Tag_Check,
- Validity_Check,
- All_Checks);
+ type Check_Id is new Nat;
+ -- Type used to represent a check id
+
+ No_Check_Id : constant := 0;
+ -- Check_Id value used to indicate no check
+
+ Access_Check : constant := 1;
+ Accessibility_Check : constant := 2;
+ Alignment_Check : constant := 3;
+ Discriminant_Check : constant := 4;
+ Division_Check : constant := 5;
+ Elaboration_Check : constant := 6;
+ Index_Check : constant := 7;
+ Length_Check : constant := 8;
+ Overflow_Check : constant := 9;
+ Range_Check : constant := 10;
+ Storage_Check : constant := 11;
+ Tag_Check : constant := 12;
+ Validity_Check : constant := 13;
+ -- Values used to represent individual predefined checks
+
+ All_Checks : constant := 14;
+ -- Value used to represent All_Checks value
+
+ subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks;
+ -- Subtype for predefined checks, including All_Checks
-- The following array contains an entry for each recognized check name
-- for pragma Suppress. It is used to represent current settings of scope
-- We recognize only an explicit suppress of Elaboration_Check as a signal
-- that the static elaboration checking should skip a compile time check.
- type Suppress_Array is array (Check_Id) of Boolean;
+ type Suppress_Array is array (Predefined_Check_Id) of Boolean;
pragma Pack (Suppress_Array);
-- To add a new check type to GNAT, the following steps are required:
-- throughout the compiler or in other GNAT tools.
Unrecoverable_Error : exception;
- -- This exception is raised to immediately terminate the compilation
- -- of the current source program. Used in situations where things are
- -- bad enough that it doesn't seem worth continuing (e.g. max errors
- -- reached, or a required file is not found). Also raised when the
- -- compiler finds itself in trouble after an error (see Comperr).
+ -- This exception is raised to immediately terminate the compilation of the
+ -- current source program. Used in situations where things are bad enough
+ -- that it doesn't seem worth continuing (e.g. max errors reached, or a
+ -- required file is not found). Also raised when the compiler finds itself
+ -- in trouble after an error (see Comperr).
Terminate_Program : exception;
-- This exception is raised to immediately terminate the tool being
- -- executed. Each tool where this exception may be raised must have
- -- a single exception handler that contains only a null statement and
- -- that is the last statement of the program. If needed, procedure
- -- Set_Exit_Status is called with the appropriate exit status before
- -- raising Terminate_Program.
+ -- executed. Each tool where this exception may be raised must have a
+ -- single exception handler that contains only a null statement and that is
+ -- the last statement of the program. If needed, procedure Set_Exit_Status
+ -- is called with the appropriate exit status before raising
+ -- Terminate_Program.
---------------------------------
-- Parameter Mechanism Control --
-- Run-Time Exception Codes --
------------------------------
- -- When the code generator generates a run-time exception, it provides
- -- a reason code which is one of the following. This reason code is used
- -- to select the appropriate run-time routine to be called, determining
- -- both the exception to be raised, and the message text to be added.
+ -- When the code generator generates a run-time exception, it provides a
+ -- reason code which is one of the following. This reason code is used to
+ -- select the appropriate run-time routine to be called, determining both
+ -- the exception to be raised, and the message text to be added.
-- The prefix CE/PE/SE indicates the exception to be raised
-- CE = Constraint_Error
OSDN Git Service
