Skip to content

R
riscv-gcc-1
Commit 939c12d2 by Robert Dewar Committed by Arnaud Charlet
Options

inline.adb, [...]: Suppress unmodified in-out parameter warning in some cases… 

inline.adb, [...]: Suppress unmodified in-out parameter warning in some cases This patch is a also...

2007-08-14  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* inline.adb, types.ads, inline.ads, frontend.adb, alloc.ads: 
	Suppress unmodified in-out parameter warning in some cases
	This patch is a also fairly significant change to the way suppressible
	checks are handled.

	* checks.ads, checks.adb (Install_Null_Excluding_Check): No check
	needed for access to concurrent record types generated by the expander.
	(Generate_Range_Check): When generating a temporary to capture the
	value of a conversion that requires a range check, set the type of the
	temporary before rewriting the node, so that the type is always
	properly placed for back-end use.
	(Apply_Float_Conversion_Check): Handle case where the conversion is
	truncating.
	(Get_Discriminal): Code reformatting. Climb the scope stack looking
	for a protected type in order to examine its discriminants.

From-SVN: r127410
parent 835d23b2
Showing with 350 additions and 205 deletions
gcc/ada/alloc.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -63,15 +63,15 @@ package Alloc is
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;
......
gcc/ada/checks.adb
......@@ -36,7 +36,6 @@ with Elists; use Elists;
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;
......@@ -220,7 +219,7 @@ package body Checks is
-- 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
......@@ -543,12 +542,12 @@ package body Checks is
("?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
......@@ -637,7 +636,7 @@ package body Checks is
-- 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
......@@ -953,7 +952,7 @@ package body Checks is
-- 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;
......@@ -1007,7 +1006,7 @@ package body Checks is
-- 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 --
......@@ -1064,7 +1063,7 @@ package body Checks is
-- 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
......@@ -1388,28 +1387,38 @@ package body Checks is
-- 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)
......@@ -1421,9 +1430,16 @@ package body Checks is
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;
......@@ -1449,10 +1465,7 @@ package body Checks is
-- 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,
......@@ -1489,9 +1502,18 @@ package body Checks is
-- 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));
......@@ -1515,7 +1537,15 @@ package body Checks is
-- 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
......@@ -1636,17 +1666,25 @@ package body Checks is
-- 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;
......@@ -2498,11 +2536,11 @@ package body Checks is
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;
......@@ -2512,6 +2550,9 @@ package body Checks is
then
return True;
end if;
when others =>
raise Program_Error;
end case;
-- Here we have the optimizable case, warn if not short-circuited
......@@ -2526,6 +2567,9 @@ package body Checks is
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
......@@ -2682,29 +2726,27 @@ package body Checks is
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);
......@@ -4459,6 +4501,12 @@ package body Checks is
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
......@@ -4626,6 +4674,32 @@ package body Checks is
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 --
---------------------
......@@ -4636,20 +4710,6 @@ package body Checks is
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.
......@@ -4657,17 +4717,48 @@ package body Checks is
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 --
------------------
......@@ -4717,6 +4808,12 @@ package body Checks is
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;
-------------------------
......@@ -4952,6 +5049,18 @@ package body Checks is
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,
......@@ -5050,22 +5159,6 @@ package body Checks is
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 --
-----------------------------
......@@ -5357,7 +5450,7 @@ package body Checks is
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
......@@ -5542,9 +5635,9 @@ package body Checks is
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;
......@@ -6193,9 +6286,9 @@ package body Checks is
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;
......
gcc/ada/checks.ads
......@@ -36,8 +36,10 @@
-- 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
......@@ -383,16 +385,28 @@ 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
......@@ -406,7 +420,7 @@ package Checks 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.
......@@ -417,19 +431,6 @@ package Checks is
-- 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 --
-----------------------
......@@ -659,6 +660,29 @@ package Checks is
-- 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;
......
gcc/ada/frontend.adb
......@@ -322,9 +322,10 @@ begin
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;
......
gcc/ada/inline.adb
......@@ -957,7 +957,6 @@ package body Inline is
-- 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
......
gcc/ada/inline.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -37,8 +37,9 @@
-- 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
......@@ -51,7 +52,7 @@ 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;
......@@ -68,6 +69,22 @@ package Inline is
-- 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 (
......
gcc/ada/types.ads
......@@ -31,13 +31,13 @@
-- --
------------------------------------------------------------------------------
-- 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.
......@@ -108,9 +108,9 @@ package Types is
-- 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#);
......@@ -134,9 +134,9 @@ package Types is
-- 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
......@@ -167,9 +167,9 @@ package Types is
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;
......@@ -183,20 +183,20 @@ package Types is
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
......@@ -215,10 +215,10 @@ package Types is
-- 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
......@@ -266,13 +266,13 @@ package Types is
-- 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
......@@ -413,10 +413,10 @@ package Types is
------------------------------
-- 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
......@@ -439,10 +439,10 @@ package Types is
-- 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)
......@@ -471,8 +471,8 @@ package Types is
-- 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
......@@ -492,15 +492,15 @@ package Types 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;
......@@ -530,7 +530,7 @@ package Types is
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),
......@@ -596,11 +596,10 @@ package Types is
-- 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
......@@ -611,14 +610,15 @@ package Types is
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;
......@@ -644,21 +644,32 @@ package Types is
-- 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
......@@ -672,7 +683,7 @@ package Types is
-- 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:
......@@ -691,19 +702,19 @@ package Types is
-- 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 --
......@@ -722,10 +733,10 @@ package Types is
-- 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment