OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

g-socket.ads (Get_Host_By_Address, [...]): Clarify documentation of the behaviour of these functions when... 

* g-socket.ads (Get_Host_By_Address, Get_Host_By_Name): Clarify
	documentation of the behaviour of these functions when passed an IP
	address that has no record in the system hosts database and no reverse
	record in the DNS.

	* cstand.adb, a-tags.ads: Fix typos in comment.

	* exp_ch2.adb, exp_ch3.adb, exp_ch5.adb, exp_ch8.adb,
	exp_ch9.adb, exp_pakd.adb, interfac.ads, sem_ch6.adb,
	sem_ch7.adb, sem_ch10.adb, sem_ch13.adb, sem_ch3.adb,
	s-poosiz.ads: Minor reformatting

	* make.adb: Minor reformatting
	Add some ??? comments asking for more comments

	* s-poosiz.adb: Minor reformatting
	Add comments on alignment requirement

	* sinfo.ads: Remove obsolete comment and fix typo.

	* gnat_ugn.texi: Update the section "The GNAT Driver and Project
	Files" with the new tool and package names.
	Reformatting to suppress most of the warnings for line too long
	Document the new section "Project Search Path:" in the output of
	gnatls -v.
	Add gnatmetric section

	* vms_data.ads: Correct GNAT METRIC qualifiers: -I-, -Idir and
	-gnatec= are not direct switches of gnatmetric. Changed -eis to -eps
	and -eit to -ept. Added qualifier
	/ELEMENT_METRICS=CONSTRUCT_NESTING_MAX for new switch -ec.

From-SVN: r91896
This commit is contained in:
Arnaud Charlet 2004-12-08 12:49:44 +01:00
parent 4e8c0836b4
commit a5b62485c3
20 changed files with 994 additions and 529 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/a-tags.ads
View File

@ -60,11 +60,11 @@ private
---------------------------------------------------------------
-- GNAT's Dispatch Table format is customizable in order to match the
-- format used in another langauge. GNAT supports programs that use
-- two different dispatch table format at the same time: the native
-- format used in another language. GNAT supports programs that use
-- two different dispatch table formats at the same time: the native
-- format that supports Ada 95 tagged types and which is described in
-- Ada.Tags and a foreign format for types that are imported from some
-- other language (typically C++) which is described in interfaces.cpp.
-- Ada.Tags, and a foreign format for types that are imported from some
-- other language (typically C++) which is described in Interfaces.CPP.
-- The runtime information kept for each tagged type is separated into
-- two objects: the Dispatch Table and the Type Specific Data record.
-- These two objects are allocated statically using the constants:

2
gcc/ada/cstand.adb
View File

@ -1045,7 +1045,7 @@ package body CStand is
Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10);
-- In standard 64-bit mode, the size is 64-bits and the delta and
-- amll values are set to nanoseconds (1.0**(10.0**(-9))
-- small values are set to nanoseconds (1.0**(10.0**(-9))
else
Dlo := Intval (Type_Low_Bound (Standard_Integer_64));

2
gcc/ada/exp_ch2.adb
View File

@ -661,7 +661,7 @@ package body Exp_Ch2 is
Set_Etype (N, Etype (Prival (E)));
Scop := Current_Scope;
-- Find entity for protected operation, which must be on scope stack.
-- Find entity for protected operation, which must be on scope stack
while not Is_Protected_Type (Scope (Scop)) loop
Scop := Scope (Scop);

16
gcc/ada/exp_ch3.adb
View File

@ -640,7 +640,7 @@ package body Exp_Ch3 is
P : Node_Id;
begin
-- Nothing to do if there is no task hierarchy.
-- Nothing to do if there is no task hierarchy
if Restriction_Active (No_Task_Hierarchy) then
return;
@ -686,7 +686,7 @@ package body Exp_Ch3 is
end loop;
end if;
-- Now define the renaming of the master_id.
-- Now define the renaming of the master_id
M_Id :=
Make_Defining_Identifier (Loc,
@ -1310,7 +1310,7 @@ package body Exp_Ch3 is
Decl : Node_Id;
begin
-- Nothing to do if there is no task hierarchy.
-- Nothing to do if there is no task hierarchy
if Restriction_Active (No_Task_Hierarchy) then
return;
@ -2663,7 +2663,7 @@ package body Exp_Ch3 is
Expressions => New_List (New_Occurrence_Of (Rnn, Loc))))),
End_Label => Empty);
-- Build exit condition.
-- Build exit condition
declare
F_Ass : constant List_Id := New_List;
@ -3970,7 +3970,7 @@ package body Exp_Ch3 is
end loop;
end if;
-- Now build an array declaration.
-- Now build an array declaration
-- typA : array (Natural range 0 .. num - 1) of ctype :=
-- (v, v, v, v, v, ....)
@ -4081,7 +4081,7 @@ package body Exp_Ch3 is
if Enumeration_Rep (Ent) = Last_Repval then
-- Another special case: for a single literal, Pos is zero.
-- Another special case: for a single literal, Pos is zero
Pos_Expr := Make_Integer_Literal (Loc, Uint_0);
@ -4542,7 +4542,7 @@ package body Exp_Ch3 is
if RACW_Seen then
-- If there are RACWs designating this type, make stubs now.
-- If there are RACWs designating this type, make stubs now
Remote_Types_Tagged_Full_View_Encountered (Def_Id);
end if;
@ -4574,7 +4574,7 @@ package body Exp_Ch3 is
begin
if Scope (Old_C) = Base_Type (Def_Id) then
-- The entity is the one in the parent. Create new one.
-- The entity is the one in the parent. Create new one
New_C := New_Copy (Old_C);
Set_Parent (New_C, Parent (Old_C));

8
gcc/ada/exp_ch5.adb
View File

@ -387,7 +387,7 @@ package body Exp_Ch5 is
-- File.Storage := Contents;
-- end Write_All;
-- We expand to a loop in either of these two cases.
-- We expand to a loop in either of these two cases
-- Question for future thought. Another potentially more efficient
-- approach would be to create the actual subtype, and then do an
@ -1459,7 +1459,7 @@ package body Exp_Ch5 is
end if;
end loop;
-- Now we can insert and analyze the pre-assignment.
-- Now we can insert and analyze the pre-assignment
-- If the right-hand side requires a transient scope, it has
-- already been placed on the stack. However, the declaration is
@ -2480,7 +2480,7 @@ package body Exp_Ch5 is
Enumeration_Rep (First_Literal (Btype))),
Right_Opnd => New_Reference_To (New_Id, Loc)));
else
-- Use the constructed array Enum_Pos_To_Rep.
-- Use the constructed array Enum_Pos_To_Rep
Expr :=
Make_Indexed_Component (Loc,
@ -2667,7 +2667,7 @@ package body Exp_Ch5 is
if No (Exp) then
Kind := Ekind (Scope_Id);
-- If it is a return from procedures do no extra steps.
-- If it is a return from procedures do no extra steps
if Kind = E_Procedure or else Kind = E_Generic_Procedure then
return;

4
gcc/ada/exp_ch8.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
@ -182,7 +182,7 @@ package body Exp_Ch8 is
elsif K = N_Type_Conversion then
Evaluate_Name (Expression (Fname));
-- For a function call, we evaluate the call.
-- For a function call, we evaluate the call
elsif K = N_Function_Call then
Force_Evaluation (Fname);

138
gcc/ada/exp_ch9.adb
View File

@ -294,7 +294,7 @@ package body Exp_Ch9 is
S : Node_Id;
function Actual_Family_Offset (Hi, Lo : Node_Id) return Node_Id;
-- Compute difference between bounds of entry family.
-- Compute difference between bounds of entry family
--------------------------
-- Actual_Family_Offset --
@ -358,7 +358,7 @@ package body Exp_Ch9 is
-- designated one, to which is added the index expression, if this
-- expression denotes a member of a family.
-- The following is a place holder for the count of simple entries.
-- The following is a place holder for the count of simple entries
Num := Make_Integer_Literal (Sloc, 1);
@ -384,7 +384,7 @@ package body Exp_Ch9 is
Expr := Num;
end if;
-- Now add lengths of preceding entries and entry families.
-- Now add lengths of preceding entries and entry families
Prev := First_Entity (Ttyp);
@ -411,7 +411,7 @@ package body Exp_Ch9 is
Right_Opnd =>
Make_Integer_Literal (Sloc, 1)));
-- Other components are anonymous types to be ignored.
-- Other components are anonymous types to be ignored
else
null;
@ -990,7 +990,7 @@ package body Exp_Ch9 is
Siz : Node_Id := Empty;
procedure Add_If_Clause (Expr : Node_Id);
-- Add test for range of current entry.
-- Add test for range of current entry
function Convert_Discriminant_Ref (Bound : Node_Id) return Node_Id;
-- If a bound of an entry is given by a discriminant, retrieve the
@ -1008,11 +1008,11 @@ package body Exp_Ch9 is
Expression => Make_Integer_Literal (Loc, Index + 1)));
begin
-- Index for current entry body.
-- Index for current entry body
Index := Index + 1;
-- Compute total length of entry queues so far.
-- Compute total length of entry queues so far
if No (Siz) then
Siz := Expr;
@ -1720,7 +1720,7 @@ package body Exp_Ch9 is
Parameter_Associations => Uactuals);
end if;
-- Wrap call in block that will be covered by an at_end handler.
-- Wrap call in block that will be covered by an at_end handler
if not Exc_Safe then
Unprot_Call := Make_Block_Statement (Loc,
@ -2029,7 +2029,7 @@ package body Exp_Ch9 is
Conctyp := Designated_Type (Conctyp);
end if;
-- Special case for protected subprogram calls.
-- Special case for protected subprogram calls
if Is_Protected_Type (Conctyp)
and then Is_Subprogram (Entity (Ename))
@ -2678,10 +2678,8 @@ package body Exp_Ch9 is
-- objectV!(name)._Object
-- for a protected object.
-- For the case of an access to a concurrent object,
-- there is an extra explicit dereference:
-- for a protected object. For the case of an access to a concurrent
-- object, there is an extra explicit dereference:
-- taskV!(name.all)._Task_Id
-- objectV!(name.all)._Object
@ -2872,7 +2870,7 @@ package body Exp_Ch9 is
-- designated one, to which is added the index expression, if this
-- expression denotes a member of a family.
-- The following is a place holder for the count of simple entries.
-- The following is a place holder for the count of simple entries
Num := Make_Integer_Literal (Sloc, 1);
@ -2916,7 +2914,7 @@ package body Exp_Ch9 is
Expr := Num;
end if;
-- Now add lengths of preceding entries and entry families.
-- Now add lengths of preceding entries and entry families
Prev := First_Entity (Ttyp);
@ -2938,7 +2936,7 @@ package body Exp_Ch9 is
Left_Opnd => Expr,
Right_Opnd => Family_Size (Sloc, Hi, Lo, Ttyp));
-- Other components are anonymous types to be ignored.
-- Other components are anonymous types to be ignored
else
null;
@ -3117,7 +3115,7 @@ package body Exp_Ch9 is
pragma Assert (Nkind (Acc_Alt) = N_Accept_Alternative);
pragma Assert (Nkind (Sel_Acc) = N_Selective_Accept);
-- ??? Consider a single label for select statements.
-- ??? Consider a single label for select statements
if Present (Handled_Statement_Sequence (N)) then
Prepend (Ldecl2,
@ -3262,7 +3260,7 @@ package body Exp_Ch9 is
Def1 : Node_Id;
begin
-- Create access to protected subprogram with full signature.
-- Create access to protected subprogram with full signature
if Nkind (Type_Definition (N)) = N_Access_Function_Definition then
Def1 :=
@ -3739,19 +3737,19 @@ package body Exp_Ch9 is
-- Expand_N_Asynchronous_Select --
----------------------------------
-- This procedure assumes that the trigger statement is an entry
-- call. A delay alternative should already have been expanded
-- into an entry call to the appropriate delay object Wait entry.
-- This procedure assumes that the trigger statement is an entry call. A
-- delay alternative should already have been expanded into an entry call
-- to the appropriate delay object Wait entry.
-- If the trigger is a task entry call, the select is implemented
-- with Task_Entry_Call:
-- If the trigger is a task entry call, the select is implemented with
-- a Task_Entry_Call:
-- declare
-- B : Boolean;
-- C : Boolean;
-- P : parms := (parm, parm, parm);
-- -- Clean is added by Exp_Ch7.Expand_Cleanup_Actions.
-- -- Clean is added by Exp_Ch7.Expand_Cleanup_Actions
-- procedure _clean is
-- begin
@ -3867,16 +3865,16 @@ package body Exp_Ch9 is
-- ...
-- end;
-- The job is to convert this to the asynchronous form.
-- The job is to convert this to the asynchronous form
-- If the trigger is a delay statement, it will have been expanded
-- into a call to one of the GNARL delay procedures. This routine
-- will convert this into a protected entry call on a delay object
-- and then continue processing as for a protected entry call trigger.
-- This requires declaring a Delay_Block object and adding a pointer
-- to this object to the parameter list of the delay procedure to form
-- the parameter list of the entry call. This object is used by
-- the runtime to queue the delay request.
-- If the trigger is a delay statement, it will have been expanded into a
-- call to one of the GNARL delay procedures. This routine will convert
-- this into a protected entry call on a delay object and then continue
-- processing as for a protected entry call trigger. This requires
-- declaring a Delay_Block object and adding a pointer to this object to
-- the parameter list of the delay procedure to form the parameter list of
-- the entry call. This object is used by the runtime to queue the delay
-- request.
-- For a description of the use of P and the assignments after the
-- call, see Expand_N_Entry_Call_Statement.
@ -3961,7 +3959,7 @@ package body Exp_Ch9 is
Prefix => New_Reference_To (Dblock_Ent, Loc),
Attribute_Name => Name_Unchecked_Access));
-- Create the inner block to protect the abortable part.
-- Create the inner block to protect the abortable part
Hdle := New_List (
Make_Exception_Handler (Loc,
@ -4191,7 +4189,7 @@ package body Exp_Ch9 is
Defining_Identifier => Cancel_Param,
Object_Definition => New_Reference_To (Standard_Boolean, Loc)));
-- Remove and save the call to Call_Simple.
-- Remove and save the call to Call_Simple
Stmt := First (Stmts);
@ -4205,7 +4203,7 @@ package body Exp_Ch9 is
Call := Stmt;
-- Create the inner block to protect the abortable part.
-- Create the inner block to protect the abortable part
Hdle := New_List (
Make_Exception_Handler (Loc,
@ -4556,7 +4554,7 @@ package body Exp_Ch9 is
Index_Decl : List_Id;
begin
-- Add the renamings for private declarations and discriminants.
-- Add the renamings for private declarations and discriminants
Add_Discriminal_Declarations
(Declarations (N), Defining_Identifier (Dec), Name_uObject, Loc);
@ -4882,7 +4880,7 @@ package body Exp_Ch9 is
when N_Subprogram_Body =>
-- Exclude functions created to analyze defaults.
-- Exclude functions created to analyze defaults
if not Is_Eliminated (Defining_Entity (Op_Body))
and then not Is_Eliminated (Corresponding_Spec (Op_Body))
@ -5663,7 +5661,7 @@ package body Exp_Ch9 is
-- <some more of the statement sequence for entry>
-- -- Requeue from an entry body to a task entry.
-- -- Requeue from an entry body to a task entry
-- Requeue_Protected_To_Task_Entry (
-- New._task_id,
@ -5681,7 +5679,7 @@ package body Exp_Ch9 is
-- end;
-- end entE;
-- Requeue of a task entry call to a task entry.
-- Requeue of a task entry call to a task entry
-- Accept_Call (E, Ann);
-- <start of statement sequence for accept statement>
@ -5695,7 +5693,7 @@ package body Exp_Ch9 is
-- when all others =>
-- Exceptional_Complete_Rendezvous (Get_GNAT_Exception);
-- Requeue of a task entry call to a protected entry.
-- Requeue of a task entry call to a protected entry
-- Accept_Call (E, Ann);
-- <start of statement sequence for accept statement>
@ -5933,7 +5931,7 @@ package body Exp_Ch9 is
-- statements of an accept or delay alternative.
function Make_Select_Call (Select_Mode : Entity_Id) return Node_Id;
-- Build call to Selective_Wait runtime routine.
-- Build call to Selective_Wait runtime routine
procedure Process_Delay_Alternative (Alt : Node_Id; Index : Int);
-- Add code to compare value of delay with previous values, and
@ -6176,7 +6174,7 @@ package body Exp_Ch9 is
if No (Alt_Stats) then
-- Accept with no body, followed by trailing statements.
-- Accept with no body, followed by trailing statements
Choices := New_List (
Make_Integer_Literal (Loc, Index));
@ -6225,7 +6223,8 @@ package body Exp_Ch9 is
Adjust_Condition (Condition (Alt));
-- Determine the smallest specified delay.
-- Determine the smallest specified delay
-- for each delay alternative generate:
-- if guard-expression then
@ -6237,7 +6236,7 @@ package body Exp_Ch9 is
-- end if;
-- end if;
-- The enclosing if-statement is omitted if there is no guard.
-- The enclosing if-statement is omitted if there is no guard
if Delay_Count = 1
or else First_Delay
@ -6402,7 +6401,7 @@ package body Exp_Ch9 is
if No (Condition (Alt)) then
-- This guard will always be open.
-- This guard will always be open
Check_Guard := False;
end if;
@ -6467,7 +6466,7 @@ package body Exp_Ch9 is
Append (X, Decls);
-- After this follow procedure declarations for each accept body.
-- After this follow procedure declarations for each accept body
-- procedure Pnn is
-- begin
@ -6490,7 +6489,7 @@ package body Exp_Ch9 is
-- build them unconditionally, and not significantly inefficient,
-- since if they are short they will be inlined anyway.
-- The procedure declarations have been assembled in Body_List.
-- The procedure declarations have been assembled in Body_List
-- If delays are present, we must compute the required delay.
-- We first generate the declarations:
@ -6500,10 +6499,11 @@ package body Exp_Ch9 is
-- Delay_Val : Some_Time_Type.Time;
-- Delay_Index will be set to the index of the minimum delay, i.e. the
-- active delay that is actually chosen as the basis for the possible
-- delay if an immediate rendez-vous is not possible.
-- In the most common case there is a single delay statement, and this
-- is handled specially.
-- active delay that is actually chosen as the basis for the possible
-- delay if an immediate rendez-vous is not possible.
-- In the most common case there is a single delay statement, and this
-- is handled specially.
if Delay_Count > 0 then
@ -6655,17 +6655,17 @@ package body Exp_Ch9 is
-- ...
-- Exit:
-- Generate label for common exit.
-- Generate label for common exit
End_Lab := Make_And_Declare_Label (Num_Alts + 1);
-- First entry is the default case, when no rendezvous is possible.
-- First entry is the default case, when no rendezvous is possible
Choices := New_List (New_Reference_To (RTE (RE_No_Rendezvous), Loc));
if Else_Present then
-- If no rendezvous is possible, the else part is executed.
-- If no rendezvous is possible, the else part is executed
Lab := Make_And_Declare_Label (0);
Alt_Stats := New_List (
@ -6831,7 +6831,7 @@ package body Exp_Ch9 is
Insert_After (Parm, New_Reference_To (M, Loc));
Insert_After (Parm, New_Reference_To (D, Loc));
-- Create a call to RTS.
-- Create a call to RTS
Rewrite (Select_Call,
Make_Procedure_Call_Statement (Loc,
@ -7216,7 +7216,7 @@ package body Exp_Ch9 is
-- This is done last, since the corresponding record initialization
-- procedure will reference the previously created entities.
-- Fill in the component declarations. First the _Task_Id field.
-- Fill in the component declarations -- first the _Task_Id field
Append_To (Cdecls,
Make_Component_Declaration (Loc,
@ -7590,7 +7590,7 @@ package body Exp_Ch9 is
B := Make_Defining_Identifier (Loc, Name_uB);
-- Create a boolean object used for a return parameter.
-- Create a boolean object used for a return parameter
Prepend_To (Decls,
Make_Object_Declaration (Loc,
@ -7635,20 +7635,20 @@ package body Exp_Ch9 is
Dummy := Remove_Next (Next (Parm));
-- In case some garbage is following the Cancel_Param, remove.
-- Remove garbage is following the Cancel_Param if present
Dummy := Next (Parm);
-- Remove the mode of the Protected_Entry_Call call, the
-- Communication_Block of the Protected_Entry_Call call, and add a
-- Duration and a Delay_Mode parameter
-- Remove the mode of the Protected_Entry_Call call, then remove the
-- Communication_Block of the Protected_Entry_Call call, and finally
-- add Duration and a Delay_Mode parameter
pragma Assert (Present (Parm));
Rewrite (Parm, New_Reference_To (D, Loc));
Rewrite (Dummy, New_Reference_To (M, Loc));
-- Add a Boolean flag for successful entry call.
-- Add a Boolean flag for successful entry call
Append_To (Parms, New_Reference_To (B, Loc));
@ -8258,7 +8258,7 @@ package body Exp_Ch9 is
or else Restriction_Active (No_Entry_Queue) = False
or else Number_Entries (Ptyp) > 1
then
-- Find index mapping function (clumsy but ok for now).
-- Find index mapping function (clumsy but ok for now)
while Ekind (P_Arr) /= E_Function loop
Next_Entity (P_Arr);
@ -8366,10 +8366,12 @@ package body Exp_Ch9 is
Next_Rep_Item (Ritem);
end loop;
-- Appends the table argument we just built.
-- Append the table argument we just built
Append_To (Args, Make_Aggregate (Loc, Table));
-- Appends the Install_Handler call to the statements.
-- Append the Install_Handler call to the statements
Append_To (L,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Install_Handlers), Loc),
@ -8807,7 +8809,9 @@ package body Exp_Ch9 is
return Skip;
elsif Nkind (N) = N_String_Literal then
-- array type, but bounds are constant.
-- Array type, but bounds are constant
return OK;
elsif Nkind (N) = N_Object_Declaration

12
gcc/ada/exp_pakd.adb
View File

@ -1347,7 +1347,7 @@ package body Exp_Pakd is
-- the "or ..." is omitted if rhs is constant and all 0 bits
-- rhs is converted to the appropriate type.
-- rhs is converted to the appropriate type
-- The result is converted back to the array type, since
-- otherwise we lose knowledge of the packed nature.
@ -1545,7 +1545,7 @@ package body Exp_Pakd is
-- Set_nn (Arr'address, Subscr, Bits_nn!(Rhs))
-- where Subscr is the computed linear subscript.
-- where Subscr is the computed linear subscript
declare
Bits_nn : constant Entity_Id := RTE (Bits_Id (Csiz));
@ -1556,7 +1556,7 @@ package body Exp_Pakd is
begin
if No (Bits_nn) then
-- Error, most likely High_Integrity_Mode restriction.
-- Error, most likely High_Integrity_Mode restriction
return;
end if;
@ -1774,7 +1774,7 @@ package body Exp_Pakd is
-- convert to the base type, since this would be unconstrained, and
-- hence not have a corresponding packed array type set.
-- Note that both operands must be modular for this code to be used.
-- Note that both operands must be modular for this code to be used
if Is_Modular_Integer_Type (PAT)
and then
@ -1916,7 +1916,7 @@ package body Exp_Pakd is
return;
end if;
-- Remaining processing is for the bit-packed case.
-- Remaining processing is for the bit-packed case
Obj := Relocate_Node (Prefix (N));
Convert_To_Actual_Subtype (Obj);
@ -1967,7 +1967,7 @@ package body Exp_Pakd is
-- Component_Type!(Get_nn (Arr'address, Subscr))
-- where Subscr is the computed linear subscript.
-- where Subscr is the computed linear subscript
declare
Get_nn : Entity_Id;

8
gcc/ada/g-socket.ads
View File

@ -502,12 +502,16 @@ package GNAT.Sockets is
function Get_Host_By_Address
(Address : Inet_Addr_Type;
Family : Family_Type := Family_Inet) return Host_Entry_Type;
-- Return host entry structure for the given inet address
-- Return host entry structure for the given Inet address.
-- Note that no result will be returned if there is no mapping of this
-- IP address to a host name in the system tables (host database,
-- DNS or otherwise).
function Get_Host_By_Name
(Name : String) return Host_Entry_Type;
-- Return host entry structure for the given host name. Here name
-- is either a host name, or an IP address.
-- is either a host name, or an IP address. If Name is an IP address,
-- this is equivalent to Get_Host_By_Address (Inet_Addr (Name)).
function Host_Name return String;
-- Return the name of the current host

520
gcc/ada/gnat_ugn.texi
View File

@ -176,6 +176,7 @@ Ada Core Technologies, Inc.@*
* GNAT Project Manager::
* The Cross-Referencing Tools gnatxref and gnatfind::
* The GNAT Pretty-Printer gnatpp::
* The GNAT Metric Tool gnatmetric::
* File Name Krunching Using gnatkr::
* Preprocessing Using gnatprep::
@ifset vms
@ -395,6 +396,10 @@ The GNAT Pretty-Printer gnatpp
* Switches for gnatpp::
* Formatting Rules::
The GNAT Metrics Tool gnatmetric
* Switches for gnatmetric::
File Name Krunching Using gnatkr
* About gnatkr::
@ -723,6 +728,11 @@ way to navigate through sources.
version of an Ada source file with control over casing, indentation,
comment placement, and other elements of program presentation style.
@item
@ref{The GNAT Metric Tool gnatmetric}, shows how to compute various
metrics for an Ada source file, such as the number of types and subprograms,
and assorted complexity measures.
@item
@ref{File Name Krunching Using gnatkr}, describes the @code{gnatkr}
file name krunching utility, used to handle shortened
@ -11185,11 +11195,17 @@ case insensitive. The following package names are legal:
@item
@code{Eliminate}
@item
@code{Pretty_Printer}
@item
@code{Metrics}
@item
@code{gnatls}
@item
@code{gnatstub}
@item
@code{IDE}
@item
@code{Language_Processing}
@end itemize
@noindent
@ -13205,6 +13221,8 @@ are project-aware:
@command{^gnatls^gnatls^},
@command{^gnatelim^gnatelim^},
@command{^gnatpp^gnatpp^},
@command{^gnatmetric^gnatmetric^},
@command{^gnatstub^gnatstub^},
and @command{^gnatxref^gnatxref^}. However, none of these tools can be invoked
directly with a project file switch (@option{^-P^/PROJECT_FILE=^}).
They must be invoked through the @command{gnat} driver.
@ -13245,6 +13263,8 @@ PREP or PREPROCESS to invoke @command{^gnatprep^gnatprep^}
@item
PP or PRETTY to invoke @command{^gnatpp^gnatpp^}
@item
METRIC to invoke @command{^gnatmetric^gnatmetric^}
@item
STUB to invoke @command{^gnatstub^gnatstub^}
@item
XREF to invoke @command{^gnatxref^gnatxref^}
@ -13286,8 +13306,8 @@ files may be specified with their path name preceded by '@@'.
@end smallexample
@noindent
In addition, for command BIND, COMP or COMPILE, FIND, ELIM, LS or LIST, LINK,
PP or PRETTY and XREF, the project file related switches
In addition, for commands BIND, COMP or COMPILE, FIND, ELIM, LS or LIST, LINK,
METRIC, PP or PRETTY, STUB and XREF, the project file related switches
(@option{^-P^/PROJECT_FILE^},
@option{^-X^/EXTERNAL_REFERENCE^} and
@option{^-vP^/MESSAGES_PROJECT_FILE=^x}) may be used in addition to
@ -13299,8 +13319,15 @@ specified on the command line, it invokes @command{^gnatpp^gnatpp^} with all
the immediate sources of the specified project file.
@noindent
For each of these commands, there is optionally a corresponding package
in the main project.
When GNAT METRIC is used with a project file, but with no source
specified on the command line, it invokes @command{^gnatmetric^gnatmetric^}
with all the immediate sources of the specified project file and with
@option{^-d^/DIRECTORY^} with the parameter pointing to the object directory
of the project.
@noindent
For each of the following commands, there is optionally a corresponding
package in the main project.
@itemize @bullet
@item
@ -13322,10 +13349,18 @@ package @code{Gnatls} for command LS or LIST (invoking @code{^gnatls^gnatls^})
@item
package @code{Linker} for command LINK (invoking @code{^gnatlink^gnatlink^})
@item
package @code{Metrics} for command METRIC
(invoking @code{^gnatmetric^gnatmetric^})
@item
package @code{Pretty_Printer} for command PP or PRETTY
(invoking @code{^gnatpp^gnatpp^})
@item
package @code{Gnatstub} for command STUB
(invoking @code{^gnatstub^gnatstub^})
@item
package @code{Cross_Reference} for command XREF (invoking
@code{^gnatxref^gnatxref^})
@ -15395,6 +15430,474 @@ end Test;
@end cartouche
@end smallexample
@c *********************************
@node The GNAT Metric Tool gnatmetric
@chapter The GNAT Metric Tool @command{gnatmetric}
@findex gnatmetric
@cindex Metric tool
@noindent
^The @command{gnatmetric} tool^GNAT METRIC^ is an ASIS-based utility
for computing various program metrics.
It takes an Ada source file as input and generates a file containing the
metrics data as output. Various switches control which
metrics are computed and output.
@command{gnatmetric} generates and uses the ASIS
tree for the input source and thus requires the input to be syntactically and
semantically legal.
If this condition is not met, @command{gnatmetric} will generate
an error message; no metric information for this file will be
computed and reported.
If the compilation unit contained in the input source depends semantically
upon units located outside the current directory, you have to provide the
source search path when invoking @command{gnatmetric}.
If these units are contained in files
with names that do not follow the GNAT file naming rules, you have to provide
the configuration file describing the corresponding naming scheme; see the
description of the @command{gnatmetric} switches below. Another possibility
is to use a project file and to
call @command{gnatmetric} through the @command{gnat} driver
The @command{gnatmetric} command has the form
@smallexample
$ gnatmetric [@var{switches}] @var{filename} [@var{-cargs gcc_switches}]
@end smallexample
@noindent
where
@itemize @bullet
@item
@var{switches} is an optional sequence of switches specifying
the set of metrics to compute and defining the destination for the
output information
@item
@var{filename} is the name (including the extension) of the source file to
process; ``wildcards'' or several file names on the same @command{gnatmetric}
command are allowed. The file name may contain path information; in this case
it does not have to follow the GNAT file naming rules
@item
@option{-cargs gcc_switches} is a list of switches that are valid switches for
@command{gcc}. They will be passed on to all compiler invocations made by
@command{gnatmetric} to generate the ASIS trees. Here you can provide
@option{-I} switches to form the source search path,
and use the @var{-gnatec} switch to set the configuration file.
@end itemize
@menu
* Switches for gnatmetric::
@end menu
@node Switches for gnatmetric
@section Switches for @command{gnatmetric}
@noindent
The following subsections describe the various switches accepted by
@command{gnatmetric}, organized by category.
@menu
* Output Files Control::
* Disable Metrics For Local Units::
* Line Metrics Control::
* Syntax Metrics Control::
* Complexity Metrics Control::
* Other gnatmetric Switches::
@end menu
@node Output Files Control
@subsection Output File Control
@cindex Output file control in @command{gnatmetric}
@noindent
@command{gnatmetric} has two output formats. It can generate the output in
textual (human-readable) form, and also as XML. By default only textual
output is generated.
When generating the output in textual form, @command{gnatmetric} creates
for each Ada source file a corresponding text file
containing the computed metrics. By default, this file
is placed in the same directory as where the source file is located, and
its name is obtained
by appending the ^@file{.metrix}^@file{$METRIX}^ suffix to the name of the
input file.
All the output information generated in XML format is placed in a single
file. By default this file is placed in the current directory and has the
name ^@file{metrix.xml}^@file{METRIX$XML}^.
Some of the computed metrics are summed over the units passed to
@command{gnatmetric}; for example, the total number of lines of code.
By default this information is sent to @file{stdout}, but a file
can be specified with the @option{-og} switch.
The following switches may be used to control the @command{gnatmetric} output:
@table @option
@cindex @option{^-x^/XML^} (@command{gnatmetric})
@item ^-x^/XML^
Generate the XML output
@cindex @option{^-nt^/NO_TEXT^} (@command{gnatmetric})
@item ^-nt^/NO_TEXT^
Do not generate the output in text form (implies @option{^-x^/XML^})
@cindex @option{^-d^/DIRECTORY^} (@command{gnatmetric})
@item ^-d @var{output_dir}^/DIRECTORY=@var{output_dir}^
Put textual files with detailed metrics into @var{output_dir}
@cindex @option{^-o^/SUFFIX_DETAILS^} (@command{gnatmetric})
@item ^-o @var{file_suffix}^/SUFFIX_DETAILS=@var{file_suffix}^
Use @var{file_suffix} to form the name of the file for the detailed metrics.
@cindex @option{^-og^/GLOBAL_OUTPUT^} (@command{gnatmetric})
@item ^-og @var{file_name}^/GLOBAL_OUTPUT=@var{file_name}^
Put global metrics info into @var{file_name}
@cindex @option{^-ox^/XML_OUTPUT^} (@command{gnatmetric})
@item ^-ox @var{file_name}^/XML_OUTPUT=@var{file_name}^
Put the XML output into @var{file_name} (also implies @option{^-x^/XML^})
@cindex @option{^-sfn^/SHORT_SOURCE_FILE_NAME^} (@command{gnatmetric})
@item ^-sfn^/SHORT_SOURCE_FILE_NAME^
Use short source file names in the output
@end table
@node Disable Metrics For Local Units
@subsection Disable Metrics For Local Units
@cindex Disable Metrics For Local Units in @command{gnatmetric}
@noindent
@command{gnatmetric} relies on the GNAT compilation model @minus{}
one compilation
unit per one source file. It computes some metrics for the whole source
file (mostly ``number of lines'' metrics) and it always computes metrics for
the top program unit of the corresponding compilation unit.
@command{gnatmetric} considers the following constructs as program units to
compute metrics for:
@itemize @bullet
@item
a library item or a subunit into a compilation unit;
@item
all kinds of bodies;
@item
declarations of tasks and protected types and objects, package and generic
@item
package declarations;
@end itemize
@noindent
That is, a subprogram declaration, a generic instantiation or a renaming is
considered as a program unit only if it is a library item of a compilation
unit.
@table @option
@cindex @option{^-n@var{x}^/SUPPRESS^} (@command{gnatmetric})
@item ^-nolocal^/SUPPRESS=LOCAL_DETAILS^
Do not compute detailed metrics for local program units
@end table
@node Line Metrics Control
@subsection Line Metrics Control
@cindex Line metrics control in @command{gnatmetric}
@noindent
For any source file containing a legal compilation unit, and for any program
unit, @command{gnatmetric} computes the following metrics:
@itemize @bullet
@item
the total number of lines in the file;
@item
the total number of code lines (i.e., non-blank lines that are not comments)
@item
the number of comment lines
@item
the number of code lines containing end-of-line comments;
@item
the number of empty lines and lines containing only space characters and/or
format effectors (blank lines)
@end itemize
If @command{gnatmetric} is invoked on more than one source file, it sums the
values of the line metrics for all the files being processed and then prints
out the cumulative results.
By default, all the line metrics are computed and reported. You can use the
following switches to select the specific line metrics to be computed and
reported (if any of these parameters is set, only explicitly specified line
metrics are computed)
@table @option
@cindex @option{^-la^/LINES_ALL^} (@command{gnatmetric})
@item ^-la^/LINES_ALL^
Compute and print out the number of all lines
@cindex @option{^-lcode^/CODE_LINES^} (@command{gnatmetric})
@item ^-lcode^/CODE_LINES^
Compute and print out the number of code lines
@cindex @option{^-lcomm^/COMENT_LINES^} (@command{gnatmetric})
@item ^-lcomm^/COMENT_LINES^
Compute and print out the number of comment lines
@cindex @option{^-leol^/MIXED_CODE_COMMENTS^} (@command{gnatmetric})
@item ^-leol^/MIXED_CODE_COMMENTS^
Compute and print out the number of code lines containing
end-of-line comments
@cindex @option{^-lb^/BLANK_LINES^} (@command{gnatmetric})
@item ^-lb^/BLANK_LINES^
Compute and print out the number of blank lines
@end table
@node Syntax Metrics Control
@subsection Syntax Metrics Control
@cindex Syntax metrics control in @command{gnatmetric}
@noindent
For any program unit, @command{gnatmetri}c computes the total number of
declarations and the total number of statements. The sum of all the statements
and all the declarations is considered as @emph{LSLOC} (Logical Source
Lines Of Code)
and is reported as a separate metric.
For any body and any task, protected, package and generic package declaration a
maximal nesting level of nested program units is computed. According to
@cite{Ada 95 Language Reference Manual}, 10.1(1), ``A program unit is either a
package, a task unit, a protected unit, a
protected entry, a generic unit, or an explicitly declared subprogram other
than an enumeration literal.''
For any program unit @command{gnatmetric} computes the maximal nesting level of
composite syntactic constructs. This corresponds to the notion of the
maximum nesting level in the GNAT built-in style checks
(see @ref{Style Checking})
For any library-level program unit @command{gnatmetric} additionally computes
the following metrics:
@table @emph
@item Public subprograms
This metric is computed for non-private compilation units only. It is a number
of the subprograms and generic subprograms declared in the given compilation
unit that can be called
or instantiated outside the unit. Formal generic subprograms and generic
instantiations are not counted. Protected subprograms are counted in the same
way as non-protected ones.
@item All subprograms
This metric is computed for all the library level bodies and subunits. The
metric is equal to a total number of subprogram bodies in the compilation unit.
Neither generic instantiations nor renamings-as-a-body nor body stubs
are counted. Any subprogram body is counted, independently of its nesting
level and enclosing constructs. Generic bodies and bodies of protected
subprograms are counted in the same way as ``usual'' subprogram bodies.
@item Public types
This metric is computed only for non-private package declarations and
generic package declarations. It is the total number of types
that can be referenced from outside this compilation unit, plus the
number of types from all the visible parts of all the visible generic packages.
Generic formal types are not counted.
@noindent
Along with counting the total number of public types, the following
types are counted and reported separately:
@itemize @bullet
@item
abstract types;
@item
tagged types (abstract, non-abstract, private, non-private). Type
extensions are @emph{not} counted as tagged types; the idea is to count
possible roots for classes of extendable types;
@item
private types (including private extensions);
@item
task types;
@item
protected types.
@end itemize
@item All types
This metric is computed for any compilation unit. It is equal to the total
number of the declarations of different types given in the compilation unit.
The private and the corresponding full type declaration are counted as one
type declaration. Incomplete type declarations and generic formal types
are not counted.
No distinction is made among different kinds of types (abstract,
private etc.); the total number of types is computed and reported.
@end table
@noindent
By default, all the syntax metrics are computed and reported. You can use the
following switches to select specific syntax metrics;
if any of these is set, only the explicitly specified metrics are computed.
@table @option
@cindex @option{^-ed^/DECLARATION_TOTAL^} (@command{gnatmetric})
@item ^-ed^/DECLARATION_TOTAL^
Compute and print out the total number of declarations
@cindex @option{^-es^/STATEMENT_TOTAL^} (@command{gnatmetric})
@item ^-es^/STATEMENT_TOTAL^
Compute and print out the total number of statements
@cindex @option{^-eps^/^} (@command{gnatmetric})
@item ^-eps^/INT_SUBPROGRAMS^
Compute and print out the number of public subprograms in a
compilation unit
@cindex @option{^-eas^/SUBPROGRAMS_ALL^} (@command{gnatmetric})
@item ^-eas^/SUBPROGRAMS_ALL^
Compute and print out the number of all the subprograms in a
compilation unit
@cindex @option{^-ept^/INT_TYPES^} (@command{gnatmetric})
@item ^-ept^/INT_TYPES^
Compute and print out the number of public types in a compilation
unit
@cindex @option{^-eat^/TYPES_ALL^} (@command{gnatmetric})
@item ^-eat^/TYPES_ALL^
Compute and print out the number of all the types in a compilation
unit
@cindex @option{^-enu^/PROGRAM_NESTING_MAX^} (@command{gnatmetric})
@item ^-enu^/PROGRAM_NESTING_MAX^
Compute and print out the maximal program unit nesting level
@cindex @option{^-ec^/CONSTRUCT_NESTING_MAX^} (@command{gnatmetric})
@item ^-ec^/CONSTRUCT_NESTING_MAX^
Compute and print out the maximal construct nesting level
@end table
@node Complexity Metrics Control
@subsection Complexity Metrics Control
@cindex Complexity metrics control in @command{gnatmetric}
@noindent
For a program unit that is an executable body (a subprogram body (including
generic bodies), task body, entry body or a package body containing
its own statement sequence ) @command{gnatmetric} computes the following
complexity metrics:
@itemize @bullet
@item
McCabe cyclomatic complexity;
@item
McCabe essential complexity;
@item
maximal loop nesting level
@end itemize
@noindent
The McCabe complexity metrics are defined
in @url{www.mccabe.com/pdf/nist235r.pdf}
According to McCabe, both control statements and short-circuit control forms
should be taken into account when computing cyclomatic complexity. For each
body, we compute three metric values:
@itemize @bullet
@item
the complexity introduced by control
statements only, without taking into account short-circuit forms,
@item
the complexity introduced by short-circuit control forms only, and
@item
the total
cyclomatic complexity, which is the sum of these two values.
@end itemize
@noindent
When computing cyclomatic and essential complexity, @command{gnatmetric} skips
the code in the exception handlers and in all the nested program units
By default, all the complexity metrics are computed and reported.
For more finely-grained control you can use
the following switches:
@table @option
@cindex @option{^-n@var{x}^/SUPPRESS^} (@command{gnatmetric})
@item ^-nocc^/SUPPRESS=CYCLOMATIC_COMPLEXITY^
Do not compute the McCabe Cyclomatic Complexity
@item ^noec-^/SUPPRESS=ESSENTIAL_COMPLEXITY^
Do not compute the Essential Complexity
@item ^-nonl^/SUPPRESS=MAXIMAL_LOOP_NESTING^
Do not compute maximal loop nesting level
@item ^-ne^/SUPPRESS=EXITS_AS_GOTOS^
Do not consider @code{exit} statements as @code{goto}s when
computing Essential Complexity
@end table
@node Other gnatmetric Switches
@subsection Other @code{gnatmetric} Switches
@noindent
Additional @command{gnatmetric} switches are as follows:
@table @option
@item ^-files @var{filename}^/FILES=@var{filename}^
@cindex @option{^-files^/FILES^} (@code{gnatmetric})
Take the argument source files from the specified file. This file should be an
ordinary textual file containing file names separated by spaces or
line breaks. You can use this switch more then once in the same call to
@command{gnatmetric}. You also can combine this switch with explicit list of
files.
@item ^-v^/VERBOSE^
@cindex @option{^-v^/VERBOSE^} (@code{gnatmetric})
Verbose mode;
@command{gnatmetric} generates version information and then
a trace of sources being procesed.
@item ^-dv^/DEBUG_OUTPUT^
@cindex @option{^-dv^/DEBUG_OUTPUT^} (@code{gnatmetric})
Debug mode;
@command{gnatmetric} generates various messages useful to understand what
happens during the metrics computation
@item ^-q^/QUIET^
@cindex @option{^-q^/QUIET^} (@code{gnatmetric})
Quiet mode.
@end table
@c ***********************************
@node File Name Krunching Using gnatkr
@chapter File Name Krunching Using @code{gnatkr}
@ -16084,7 +16587,7 @@ equivalent @code{gnatmake} flag (see @ref{Switches for gnatmake}).
@item ^-v^/OUTPUT=VERBOSE^
@cindex @option{^-v^/OUTPUT=VERBOSE^} (@code{gnatls})
Verbose mode. Output the complete source and object paths. Do not use
Verbose mode. Output the complete source, object and project paths. Do not use
the default column layout but instead use long format giving as much as
information possible on each requested units, including special
characteristics such as:
@ -16130,7 +16633,8 @@ object paths are affected by the -I switch.
@smallexample
$ gnatls -v -I.. demo1.o
GNATLS 3.10w (970212) Copyright 1999 Free Software Foundation, Inc.
GNATLS 5.03w (20041123-34)
Copyright 1997-2004 Free Software Foundation, Inc.
Source Search Path:
<Current_Directory>
@ -16142,6 +16646,10 @@ Object Search Path:
../
/home/comar/local/lib/gcc-lib/mips-sni-sysv4/2.7.2/adalib/
Project Search Path:
<Current_Directory>
/home/comar/local/lib/gnat/
./demo1.o
Unit =>
Name => demo1

62
gcc/ada/interfac.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -69,103 +69,83 @@ pragma Pure (Interfaces);
function Shift_Left
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Shift_Right
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Shift_Right_Arithmetic
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Rotate_Left
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Rotate_Right
(Value : Unsigned_8;
Amount : Natural)
return Unsigned_8;
Amount : Natural) return Unsigned_8;
function Shift_Left
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Shift_Right
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Shift_Right_Arithmetic
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Rotate_Left
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Rotate_Right
(Value : Unsigned_16;
Amount : Natural)
return Unsigned_16;
Amount : Natural) return Unsigned_16;
function Shift_Left
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Shift_Right
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Shift_Right_Arithmetic
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Rotate_Left
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Rotate_Right
(Value : Unsigned_32;
Amount : Natural)
return Unsigned_32;
Amount : Natural) return Unsigned_32;
function Shift_Left
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Shift_Right
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Shift_Right_Arithmetic
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Rotate_Left
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
function Rotate_Right
(Value : Unsigned_64;
Amount : Natural)
return Unsigned_64;
Amount : Natural) return Unsigned_64;
pragma Import (Intrinsic, Shift_Left);
pragma Import (Intrinsic, Shift_Right);

34
gcc/ada/s-poosiz.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
@ -153,8 +153,15 @@ package body System.Pool_Size is
----------------
procedure Initialize (Pool : in out Stack_Bounded_Pool) is
-- Define the appropriate alignment for allocations. This is the
-- maximum of the requested alignment, and the alignment required
-- for Storage_Count values. The latter test is to ensure that we
-- can properly reference the linked list pointers for free lists.
Align : constant SSE.Storage_Count :=
SSE.Storage_Count'Max (SSE.Storage_Count'Alignment, Pool.Alignment);
SSE.Storage_Count'Max
(SSE.Storage_Count'Alignment, Pool.Alignment);
begin
if Pool.Elmt_Size = 0 then
@ -165,7 +172,7 @@ package body System.Pool_Size is
Pool.First_Empty := 1;
-- Compute the size to allocate given the size of the element and
-- the possible Alignment clause
-- the possible alignment requirement as defined above.
Pool.Aligned_Elmt_Size :=
SSE.Storage_Count'Max (SC_Size,
@ -178,8 +185,7 @@ package body System.Pool_Size is
------------------
function Storage_Size
(Pool : Stack_Bounded_Pool)
return SSE.Storage_Count
(Pool : Stack_Bounded_Pool) return SSE.Storage_Count
is
begin
return Pool.Pool_Size;
@ -205,20 +211,17 @@ package body System.Pool_Size is
function Size
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count;
Chunk : SSE.Storage_Count) return SSE.Storage_Count;
-- Fetch the field 'size' of a chunk of available storage
function Next
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count;
Chunk : SSE.Storage_Count) return SSE.Storage_Count;
-- Fetch the field 'next' of a chunk of available storage
function Chunk_Of
(Pool : Stack_Bounded_Pool;
Addr : System.Address)
return SSE.Storage_Count;
Addr : System.Address) return SSE.Storage_Count;
-- Give the chunk number in the pool from its Address
--------------
@ -284,8 +287,7 @@ package body System.Pool_Size is
function Chunk_Of
(Pool : Stack_Bounded_Pool;
Addr : System.Address)
return SSE.Storage_Count
Addr : System.Address) return SSE.Storage_Count
is
begin
return 1 + abs (Addr - Pool.The_Pool (1)'Address);
@ -339,8 +341,7 @@ package body System.Pool_Size is
function Next
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count
Chunk : SSE.Storage_Count) return SSE.Storage_Count
is
begin
pragma Warnings (Off);
@ -397,8 +398,7 @@ package body System.Pool_Size is
function Size
(Pool : Stack_Bounded_Pool;
Chunk : SSE.Storage_Count)
return SSE.Storage_Count
Chunk : SSE.Storage_Count) return SSE.Storage_Count
is
begin
pragma Warnings (Off);

5
gcc/ada/s-poosiz.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992,1993,1994 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
@ -66,8 +66,7 @@ pragma Elaborate_Body;
end record;
function Storage_Size
(Pool : Stack_Bounded_Pool)
return System.Storage_Elements.Storage_Count;
(Pool : Stack_Bounded_Pool) return System.Storage_Elements.Storage_Count;
procedure Allocate
(Pool : in out Stack_Bounded_Pool;

50
gcc/ada/sem_ch10.adb
View File

@ -178,7 +178,7 @@ package body Sem_Ch10 is
-- analysis (should it appear otherwise in the context).
procedure Remove_Context_Clauses (N : Node_Id);
-- Subsidiary of previous one. Remove use_ and with_clauses.
-- Subsidiary of previous one. Remove use_ and with_clauses
procedure Remove_Limited_With_Clause (N : Node_Id);
-- Remove from visibility the shadow entities introduced for a package
@ -337,7 +337,7 @@ package body Sem_Ch10 is
Semantics (Lib_Unit);
Check_Unused_Withs (Get_Cunit_Unit_Number (Lib_Unit));
-- Verify that the library unit is a package declaration.
-- Verify that the library unit is a package declaration
if Nkind (Unit (Lib_Unit)) /= N_Package_Declaration
and then
@ -476,7 +476,7 @@ package body Sem_Ch10 is
if Is_Child_Spec (Unit_Node) then
-- Set the entities of all parents in the program_unit_name.
-- Set the entities of all parents in the program_unit_name
Generate_Parent_References (
Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
@ -864,7 +864,7 @@ package body Sem_Ch10 is
Next (Item);
end loop;
-- Third pass: examine all limited_with clauses.
-- Third pass: examine all limited_with clauses
Item := First (Context_Items (N));
@ -878,7 +878,7 @@ package body Sem_Ch10 is
& " package specification", Item);
end if;
-- Skip analyzing with clause if no unit, see above.
-- Skip analyzing with clause if no unit, see above
if Present (Library_Unit (Item)) then
Analyze (Item);
@ -905,7 +905,7 @@ package body Sem_Ch10 is
Nam : Entity_Id;
begin
-- The package declaration must be in the current declarative part.
-- The package declaration must be in the current declarative part
Check_Stub_Level (N);
Nam := Current_Entity_In_Scope (Id);
@ -1197,7 +1197,7 @@ package body Sem_Ch10 is
begin
Check_Stub_Level (N);
-- First occurence of name may have been as an incomplete type.
-- First occurence of name may have been as an incomplete type
if Present (Nam) and then Ekind (Nam) = E_Incomplete_Type then
Nam := Full_View (Nam);
@ -1484,7 +1484,7 @@ package body Sem_Ch10 is
begin
if not Is_Empty_List (Context_Items (N)) then
-- Save current use clauses.
-- Save current use clauses
Remove_Scope;
Remove_Context (Lib_Unit);
@ -1539,7 +1539,7 @@ package body Sem_Ch10 is
Re_Install_Use_Clauses;
Install_Context (N);
-- Restore state of suppress flags for current body.
-- Restore state of suppress flags for current body
Scope_Suppress := Svg;
@ -1568,7 +1568,7 @@ package body Sem_Ch10 is
begin
Check_Stub_Level (N);
-- First occurence of name may have been as an incomplete type.
-- First occurence of name may have been as an incomplete type
if Present (Nam) and then Ekind (Nam) = E_Incomplete_Type then
Nam := Full_View (Nam);
@ -1831,7 +1831,7 @@ package body Sem_Ch10 is
and then Present (System_Extend_Unit)
and then Present_System_Aux (N)
then
-- If the extension is not present, an error will have been emitted.
-- If the extension is not present, an error will have been emitted
null;
end if;
@ -1859,7 +1859,7 @@ package body Sem_Ch10 is
Sel : Node_Id;
procedure Decorate_Tagged_Type (T : Entity_Id);
-- Set basic attributes of type, including its class_wide type.
-- Set basic attributes of type, including its class_wide type
function In_Chain (E : Entity_Id) return Boolean;
-- Check that the imported type is not already in the homonym chain,
@ -1884,7 +1884,7 @@ package body Sem_Ch10 is
Set_Current_Entity (T);
end if;
-- Build bogus class_wide type, if not previously done.
-- Build bogus class_wide type, if not previously done
if No (Class_Wide_Type (T)) then
CW := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
@ -1999,7 +1999,7 @@ package body Sem_Ch10 is
if Nkind (Parent (P)) = N_Defining_Program_Unit_Name then
-- Make parent packages visible.
-- Make parent packages visible
declare
Parent_Comp : Node_Id;
@ -2149,7 +2149,7 @@ package body Sem_Ch10 is
Lib_Unit : constant Node_Id := Unit (N);
procedure Check_Parent_Context (U : Node_Id);
-- Examine context items of parent unit to locate with_type clauses.
-- Examine context items of parent unit to locate with_type clauses
--------------------------
-- Check_Parent_Context --
@ -2532,7 +2532,7 @@ package body Sem_Ch10 is
Withn : Node_Id;
function Build_Ancestor_Name (P : Node_Id) return Node_Id;
-- Build prefix of child unit name. Recurse if needed.
-- Build prefix of child unit name. Recurse if needed
function Build_Unit_Name return Node_Id;
-- If the unit is a child unit, build qualified name with all
@ -2657,7 +2657,7 @@ package body Sem_Ch10 is
then
if Limited_Present (Item) then
-- Limited withed units will be installed later.
-- Limited withed units will be installed later
goto Continue;
@ -4167,7 +4167,7 @@ package body Sem_Ch10 is
Lib_Unit : constant Node_Id := Unit (N);
begin
-- If this is a child unit, first remove the parent units.
-- If this is a child unit, first remove the parent units
if Is_Child_Spec (Lib_Unit) then
Remove_Parents (Lib_Unit);
@ -4394,7 +4394,11 @@ package body Sem_Ch10 is
P : Entity_Id;
procedure Unchain (E : Entity_Id);
-- Remove entity from visibility list.
-- Remove entity from visibility list
-------------
-- Unchain --
-------------
procedure Unchain (E : Entity_Id) is
Prev : Entity_Id;
@ -4424,13 +4428,15 @@ package body Sem_Ch10 is
end if;
end Unchain;
-- Start of Remove_With_Type_Clause
-- Start of processing for Remove_With_Type_Clause
begin
if Nkind (Name) = N_Selected_Component then
Typ := Entity (Selector_Name (Name));
if No (Typ) then -- error in declaration.
-- If no Typ, then error in declaration, ignore
if No (Typ) then
return;
end if;
else
@ -4456,7 +4462,7 @@ package body Sem_Ch10 is
Set_From_With_Type (P, False);
-- If P is a child unit, remove parents as well.
-- If P is a child unit, remove parents as well
P := Scope (P);

8
gcc/ada/sem_ch13.adb
View File

@ -83,7 +83,7 @@ package body Sem_Ch13 is
-- operational attributes.
function Address_Aliased_Entity (N : Node_Id) return Entity_Id;
-- If expression N is of the form E'Address, return E.
-- If expression N is of the form E'Address, return E
procedure Mark_Aliased_Address_As_Volatile (N : Node_Id);
-- This is used for processing of an address representation clause. If
@ -2131,7 +2131,7 @@ package body Sem_Ch13 is
("component clause previously given#", CC);
else
-- Update Fbit and Lbit to the actual bit number.
-- Update Fbit and Lbit to the actual bit number
Fbit := Fbit + UI_From_Int (SSU) * Posit;
Lbit := Lbit + UI_From_Int (SSU) * Posit;
@ -2647,7 +2647,7 @@ package body Sem_Ch13 is
return;
end if;
-- Otherwise look at the identifier and see if it is OK.
-- Otherwise look at the identifier and see if it is OK
if Ekind (Ent) = E_Named_Integer
or else
@ -3206,7 +3206,7 @@ package body Sem_Ch13 is
raise Program_Error;
end if;
-- Fall through with Hi and Lo set. Deal with biased case.
-- Fall through with Hi and Lo set. Deal with biased case
if (Biased and then not Is_Fixed_Point_Type (T))
or else Has_Biased_Representation (T)

559
gcc/ada/sem_ch3.adb
View File

File diff suppressed because it is too large Load Diff

18
gcc/ada/sem_ch6.adb
View File

@ -129,15 +129,6 @@ package body Sem_Ch6 is
-- N is the N_Subprogram_Body node for a subprogram. This routine applies
-- the alpha ordering rule for N if this ordering requirement applicable.
function Is_Non_Overriding_Operation
(Prev_E : Entity_Id;
New_E : Entity_Id) return Boolean;
-- Enforce the rule given in 12.3(18): a private operation in an instance
-- overrides an inherited operation only if the corresponding operation
-- was overriding in the generic. This can happen for primitive operations
-- of types derived (in the generic unit) from formal private or formal
-- derived types.
procedure Check_Returns
(HSS : Node_Id;
Mode : Character;
@ -172,6 +163,15 @@ package body Sem_Ch6 is
-- sufficient: the formals must become the current entities for
-- their names.
function Is_Non_Overriding_Operation
(Prev_E : Entity_Id;
New_E : Entity_Id) return Boolean;
-- Enforce the rule given in 12.3(18): a private operation in an instance
-- overrides an inherited operation only if the corresponding operation
-- was overriding in the generic. This can happen for primitive operations
-- of types derived (in the generic unit) from formal private or formal
-- derived types.
procedure Make_Inequality_Operator (S : Entity_Id);
-- Create the declaration for an inequality operator that is implicitly
-- created by a user-defined equality operator that yields a boolean.

14
gcc/ada/sem_ch7.adb
View File

@ -92,7 +92,7 @@ package body Sem_Ch7 is
-- is an inner package.
function Is_Private_Base_Type (E : Entity_Id) return Boolean;
-- True for a private type that is not a subtype.
-- True for a private type that is not a subtype
function Is_Visible_Dependent (Dep : Entity_Id) return Boolean;
-- If the private dependent is a private type whose full view is
@ -288,7 +288,7 @@ package body Sem_Ch7 is
Append_Entity (Body_Id, Scope (Spec_Id));
end if;
-- Indicate that we are currently compiling the body of the package.
-- Indicate that we are currently compiling the body of the package
Set_In_Package_Body (Spec_Id);
Set_Has_Completion (Spec_Id);
@ -377,7 +377,7 @@ package body Sem_Ch7 is
End_Package_Scope (Spec_Id);
-- All entities declared in body are not visible.
-- All entities declared in body are not visible
declare
E : Entity_Id;
@ -877,7 +877,7 @@ package body Sem_Ch7 is
Analyze_Declarations (Vis_Decls);
end if;
-- Verify that incomplete types have received full declarations.
-- Verify that incomplete types have received full declarations
E := First_Entity (Id);
while Present (E) loop
@ -1485,7 +1485,7 @@ package body Sem_Ch7 is
Next_Entity (Id);
end loop;
-- Next make other declarations in the private part visible as well.
-- Next make other declarations in the private part visible as well
Id := First_Private_Entity (P);
@ -1669,7 +1669,7 @@ package body Sem_Ch7 is
-- that need to be available for the partial view also.
function Type_In_Use (T : Entity_Id) return Boolean;
-- Check whether type or base type appear in an active use_type clause.
-- Check whether type or base type appear in an active use_type clause
------------------------------
-- Preserve_Full_Attributes --
@ -1767,7 +1767,7 @@ package body Sem_Ch7 is
In_Use (P) and not Is_Hidden (Id));
end if;
-- Local entities are not immediately visible outside of the package.
-- Local entities are not immediately visible outside of the package
Set_Is_Immediately_Visible (Id, False);

15
gcc/ada/sinfo.ads
View File

@ -2159,7 +2159,7 @@ package Sinfo is
-- INTEGER_TYPE_DEFINITION ::=
-- SIGNED_INTEGER_TYPE_DEFINITION
-- MODULAR_TYPE_DEFINITION
-- | MODULAR_TYPE_DEFINITION
-------------------------------------------
-- 3.5.4 Signed Integer Type Definition --
@ -2168,17 +2168,17 @@ package Sinfo is
-- SIGNED_INTEGER_TYPE_DEFINITION ::=
-- range static_SIMPLE_EXPRESSION .. static_SIMPLE_EXPRESSION
-- Note: the Low_Bound and High_Bound fields are set to Empty for
-- integer types defined in package Standard.
-- Note: the Low_Bound and High_Bound fields are set to Empty
-- for integer types defined in package Standard.
-- N_Signed_Integer_Type_Definition
-- Sloc points to RANGE
-- Low_Bound (Node1)
-- High_Bound (Node2)
-----------------------------------------
-- 3.5.4 Unsigned Range Specification --
-----------------------------------------
------------------------------------
-- 3.5.4 Modular Type Definition --
------------------------------------
-- MODULAR_TYPE_DEFINITION ::= mod static_EXPRESSION
@ -2236,9 +2236,6 @@ package Sinfo is
-- Note: In Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
-- Note: the Delta_Expression and Real_Range_Specification fields
-- are set to Empty for fixed point types declared in Standard.
-- N_Ordinary_Fixed_Point_Definition
-- Sloc points to DELTA
-- Delta_Expression (Node3)

40
gcc/ada/vms_data.ads
View File

@ -4051,22 +4051,6 @@ package VMS_Data is
-- Switches for GNAT METRIC --
------------------------------
S_Metric_Config : aliased constant S := "/CONFIGURATION_PRAGMAS_FILE=<" &
"-gnatec>";
-- /CONFIGURATION_PRAGMAS_FILE=file
--
-- Specify a configuration pragmas file that need to be taken into account
S_Metric_Current : aliased constant S := "/CURRENT_DIRECTORY " &
"!-I-";
-- /CURRENT_DIRECTORY (D)
--
-- Look for files in the directory where GNAT METRIC was invoked
--
-- /NOCURRENT_DIRECTORY
--
-- Do not look for files in the directory where GNAT METRIC was invoked
S_Metric_Debug : aliased constant S := "/DEBUG_OUTPUT " &
"-dv";
-- /DEBUG_OUTPUT
@ -4082,8 +4066,9 @@ package VMS_Data is
S_Metric_Element : aliased constant S := "/ELEMENT_METRICS=" &
"ALL " &
"!-ed,!-es,!-enl,!-eis," &
"!-eas,!-eit,!-eat,!-enu " &
"!-ed,!-es,!-enl,!-eps," &
"!-eas,!-ept,!-eat,!-enu," &
"!-ec " &
"DECLARATION_TOTAL " &
"-ed " &
"STATEMENT_TOTAL " &
@ -4091,15 +4076,17 @@ package VMS_Data is
"LOOP_NESTING_MAX " &
"-enl " &
"INT_SUBPROGRAMS " &
"-eis " &
"-eps " &
"SUBPROGRAMS_ALL " &
"-eas " &
"INT_TYPES " &
"-eit " &
"-ept " &
"TYPES_ALL " &
"-eat " &
"PROGRAM_NESTING_MAX " &
"-enu";
"-enu " &
"CONSTRUCT_NESTING_MAX " &
"-ec";
-- /ELEMENT_METRICS=(option, option ...)
--
-- Specifies the element metrics to be computed (if not set, all the
@ -4232,12 +4219,6 @@ package VMS_Data is
-- the number of program units left to be processed. This option turns
-- this trace off.
S_Metric_Search : aliased constant S := "/SEARCH=*" &
"-I*";
-- /SEARCH=(directory, ...)
--
-- When looking for source files also look in the specified directories.
S_Metric_Suffix : aliased constant S := "/SUFFIX_DETAILS=" & '"' &
"-o" & '"';
-- /SUFFIX_DETAILS=suffix
@ -4290,9 +4271,7 @@ package VMS_Data is
-- Place the XML output into the specified file
Metric_Switches : aliased constant Switches :=
(S_Metric_Config 'Access,
S_Metric_Current 'Access,
S_Metric_Debug 'Access,
(S_Metric_Debug 'Access,
S_Metric_Direct 'Access,
S_Metric_Element 'Access,
S_Metric_Ext 'Access,
@ -4303,7 +4282,6 @@ package VMS_Data is
S_Metric_Mess 'Access,
S_Metric_Project 'Access,
S_Metric_Quiet 'Access,
S_Metric_Search 'Access,
S_Metric_Suffix 'Access,
S_Metric_Suppress 'Access,
S_Metric_Verbose 'Access,