Skip to content

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

s-intman-irix.adb, [...]: Minor reformatting 

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

	* s-intman-irix.adb, s-osinte-irix.adb, s-osinte-irix.ads,
	s-proinf-irix-athread.ads, s-osinte-hpux-dce.adb, s-osinte-hpux-dce.ads,
	s-parame-hpux.ads, s-intman-dummy.adb, s-tasinf-solaris.adb,
	s-tasinf-solaris.ads, s-asthan-vms-alpha.adb, s-inmaop-vms.adb,
	s-intman-vms.adb, s-intman-vms.ads, s-osprim-mingw.adb,
	s-parame-vms-restrict.ads, s-parame-ae653.ads, s-intman-vxworks.ads,
	s-intman-vxworks.ads, s-intman-vxworks.adb, s-parame-vxworks.ads,
	s-tfsetr-vxworks.adb, s-interr.adb, s-interr.ads, a-tasatt.adb,
	exp_ch13.adb, s-htable.ads, s-imgboo.ads, s-imglli.ads, s-imgllu.ads,
	s-imguns.ads, g-eacodu.adb, par-ch12.adb, s-stache.ads, s-stausa.adb,
	s-poosiz.adb, s-parame.ads, s-mastop.ads, s-osinte-darwin.ads,
	a-chtgke.adb, s-asthan-vms-alpha.adb, s-parame-vms-alpha.ads,
	s-parame-vms-ia64.ads, s-parame-vxworks.adb, s-except.ads,
	g-altcon.adb: Minor reformatting

	ada-tree.h: Delete empty line.

	ali.ads: Minor reformatting
	Clarification of comments.
	Minor spelling correction

	* exp_dbug.adb: Add Warnings Off to suppress new warning

	* a-witeio.adb (Write): Add Warnings (Off) for unneeded IN OUT mode
	formal

	* a-strunb.adb (Set_Unbounded_String): Avoid memory leak by freeing old
	value

	* a-textio.adb (Write): Remove an unnecessary IN OUT mode from

	* a-textio.ads: Reorder the standard input/output/error declarations
	for consistency.

	* g-dirope.adb, g-dirope.ads: Change Dir to mode IN for Open call

	* par-ch2.adb: Recognize RM specially in errout
	Change 'R'M to RM in all error messages

	* scng.adb: Recognize RM specially in errout

	* sem.ads, sem.adb, exp_strm.adb, exp_ch5.ads, expander.adb: Rename
	N_Return node to be N_Simple_Return, to reflect Ada 2005 terminology.

	* s-direio.adb: Add missing routine header box.

	* sem_attr.ads: Add ??? comments

	* sem_eval.adb: Recognize RM specially in errout
	Change 'R'M to RM in all error messages

	* sem_maps.adb, sem_maps.ads: Remove some unnecessary IN OUT modes

	* s-tasinf.ads: Fix minor comment typo.

	* a-cihama.adb: Minor comment addition

	* a-ztexio.adb (Write): Add Warnings (Off) for unneeded IN OUT mode
	formal

	* s-tasinf-tru64.ads: Fix minor comment typo.

	* itypes.ads: Comment update.

	* ali-util.adb: Remove Generic_Separately_Compiled guard, not needed
	anymore.

	* argv.c: Added protection against null gnat_argv and gnat_envp.

	* bcheck.adb (Check_Consistency): Use correct markup character ({) in
	warning message when Tolerate_Consistency_Errors is True.

	* cstand.adb (Create_Standard): Do not call Init_Size_Alignment for
	Any_Id, as this subprogram is only applicable to *type* entities (it
	sets RM_Size). Instead initialize just Esize and Alignment.

From-SVN: r127440
parent 9410151a
Showing with 390 additions and 272 deletions
gcc/ada/a-chtgke.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......@@ -268,7 +268,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
return;
end if;
-- The node is a bucket different from the bucket implied by Key.
-- The node is a bucket different from the bucket implied by Key
if HT.Busy > 0 then
raise Program_Error with
......
gcc/ada/a-cihama.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......
gcc/ada/a-strunb.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
......@@ -847,10 +847,12 @@ package body Ada.Strings.Unbounded is
(Target : out Unbounded_String;
Source : String)
is
Old : String_Access := Target.Reference;
begin
Target.Last := Source'Length;
Target.Reference := new String (1 .. Source'Length);
Target.Reference.all := Source;
Free (Old);
end Set_Unbounded_String;
-----------
......
gcc/ada/a-textio.adb
......@@ -1810,6 +1810,9 @@ package body Ada.Text_IO is
(File : in out Text_AFCB;
Item : Stream_Element_Array)
is
pragma Warnings (Off, File);
-- Because in this implementation we don't need IN OUT, we only read
function Has_Translated_Characters return Boolean;
-- return True if Item array contains a character which will be
-- translated under the text file mode. There is only one such
......@@ -1822,6 +1825,10 @@ package body Ada.Text_IO is
Siz : constant size_t := Item'Length;
-------------------------------
-- Has_Translated_Characters --
-------------------------------
function Has_Translated_Characters return Boolean is
begin
for K in Item'Range loop
......@@ -1833,7 +1840,10 @@ package body Ada.Text_IO is
end Has_Translated_Characters;
Needs_Binary_Write : constant Boolean :=
text_translation_required and then Has_Translated_Characters;
text_translation_required
and then Has_Translated_Characters;
-- Start of processing for Write
begin
if File.Mode = FCB.In_File then
......@@ -1853,7 +1863,6 @@ package body Ada.Text_IO is
-- with text mode if needed.
if Needs_Binary_Write then
if fflush (File.Stream) = -1 then
raise Device_Error;
end if;
......@@ -1869,7 +1878,6 @@ package body Ada.Text_IO is
-- we reset to text mode.
if Needs_Binary_Write then
if fflush (File.Stream) = -1 then
raise Device_Error;
end if;
......@@ -1887,6 +1895,7 @@ package body Ada.Text_IO is
Err_Name : aliased String := "*stderr" & ASCII.Nul;
In_Name : aliased String := "*stdin" & ASCII.Nul;
Out_Name : aliased String := "*stdout" & ASCII.Nul;
begin
-------------------------------
-- Initialize Standard Files --
......
gcc/ada/a-textio.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. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -391,13 +391,13 @@ private
Null_Str : aliased constant String := "";
-- Used as name and form of standard files
Standard_Err_AFCB : aliased Text_AFCB;
Standard_In_AFCB : aliased Text_AFCB;
Standard_Out_AFCB : aliased Text_AFCB;
Standard_Err_AFCB : aliased Text_AFCB;
Standard_Err : aliased File_Type := Standard_Err_AFCB'Access;
Standard_In : aliased File_Type := Standard_In_AFCB'Access;
Standard_Out : aliased File_Type := Standard_Out_AFCB'Access;
Standard_Err : aliased File_Type := Standard_Err_AFCB'Access;
-- Standard files
Current_In : aliased File_Type := Standard_In;
......
gcc/ada/a-witeio.adb
......@@ -1806,6 +1806,9 @@ package body Ada.Wide_Text_IO is
(File : in out Wide_Text_AFCB;
Item : Stream_Element_Array)
is
pragma Warnings (Off, File);
-- Because in this implementation we don't need IN OUT, we only read
Siz : constant size_t := Item'Length;
begin
......
gcc/ada/a-ztexio.adb
......@@ -1807,6 +1807,9 @@ package body Ada.Wide_Wide_Text_IO is
(File : in out Wide_Wide_Text_AFCB;
Item : Stream_Element_Array)
is
pragma Warnings (Off, File);
-- Because in this implementation we don't need IN OUT, we only read
Siz : constant size_t := Item'Length;
begin
......
gcc/ada/ada-tree.h
......@@ -37,7 +37,6 @@ enum gnat_tree_code {
union lang_tree_node
GTY((desc ("0"),
chain_next ("(union lang_tree_node *)GENERIC_NEXT (&%h.t)")))
{
union tree_node GTY((tag ("0"))) t;
};
......
gcc/ada/ali-util.adb
......@@ -26,7 +26,6 @@
with Debug; use Debug;
with Binderr; use Binderr;
with Lib; use Lib;
with Opt; use Opt;
with Output; use Output;
with Osint; use Osint;
......@@ -248,21 +247,17 @@ package body ALI.Util is
then
Text := Read_Library_Info (Afile);
-- Return with an error if source cannot be found and if this
-- is not a library generic (now we can, but does not have to
-- compile library generics)
-- Return with an error if source cannot be found. We used to
-- skip this check when we did not compile library generics
-- separately, but we now always do, so there is no special
-- case here anymore.
if Text = null then
if Generic_Separately_Compiled (Withs.Table (W).Sfile) then
Error_Msg_File_1 := Afile;
Error_Msg_File_2 := Withs.Table (W).Sfile;
Error_Msg ("{ not found, { must be compiled");
Set_Name_Table_Info (Afile, Int (No_Unit_Id));
return;
else
goto Skip_Library_Generics;
end if;
end if;
-- Enter in ALIs table
......@@ -307,8 +302,6 @@ package body ALI.Util is
Read_ALI (Idread);
end if;
<<Skip_Library_Generics>> null;
-- If the ALI file has already been processed and is an interface,
-- set the flag in the entry of the Withs table.
......
gcc/ada/ali.ads
......@@ -261,16 +261,16 @@ package ALI is
-- have an elaboration routine (since it has no elaboration code).
Pure : Boolean;
-- Indicates presence of PU parameter for a pure package
-- Indicates presence of PU parameter for a package having pragma Pure
Dynamic_Elab : Boolean;
-- Set to True if the unit was compiled with dynamic elaboration
-- checks (i.e. either -gnatE or pragma Elaboration_Checks (RM)
-- was used to compile the unit).
-- Set to True if the unit was compiled with dynamic elaboration checks
-- (i.e. either -gnatE or pragma Elaboration_Checks (RM) was used to
-- compile the unit).
Elaborate_Body : Boolean;
-- Indicates presence of EB parameter for a package which has a
-- pragma Preelaborate_Body.
-- Indicates presence of EB parameter for a package which has a pragma
-- Elaborate_Body, and also for generic package instantiations.
Set_Elab_Entity : Boolean;
-- Indicates presence of EE parameter for a unit which has an
......@@ -278,20 +278,20 @@ package ALI is
-- elaboration of the entity.
Has_RACW : Boolean;
-- Indicates presence of RA parameter for a package that declares
-- at least one Remote Access to Class_Wide (RACW) object.
-- Indicates presence of RA parameter for a package that declares at
-- least one Remote Access to Class_Wide (RACW) object.
Remote_Types : Boolean;
-- Indicates presence of RT parameter for a package which has a
-- pragma Remote_Types.
Shared_Passive : Boolean;
-- Indicates presence of SP parameter for a package which has a
-- pragma Shared_Passive.
-- Indicates presence of SP parameter for a package which has a pragma
-- Shared_Passive.
RCI : Boolean;
-- Indicates presence of RC parameter for a package which has a
-- pragma Remote_Call_Interface.
-- Indicates presence of RC parameter for a package which has a pragma
-- Remote_Call_Interface.
Predefined : Boolean;
-- Indicates if unit is language predefined (or a child of such a unit)
......@@ -327,13 +327,13 @@ package ALI is
Icasing : Casing_Type;
-- Indicates casing of identifiers in source file for this unit. This
-- is used for informational output, and also for constructing the
-- main unit if it is being built in Ada.
-- is used for informational output, and also for constructing the main
-- unit if it is being built in Ada.
Kcasing : Casing_Type;
-- Indicates casing of keyowords in source file for this unit. This
-- is used for informational output, and also for constructing the
-- main unit if it is being built in Ada.
-- Indicates casing of keywords in source file for this unit. This is
-- used for informational output, and also for constructing the main
-- unit if it is being built in Ada.
Elab_Position : aliased Natural;
-- Initialized to zero. Set non-zero when a unit is chosen and
......
gcc/ada/argv.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2003 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- *
......@@ -79,12 +79,16 @@ __gnat_arg_count (void)
int
__gnat_len_arg (int arg_num)
{
if (gnat_argv != NULL)
return strlen (gnat_argv[arg_num]);
else
return 0;
}
void
__gnat_fill_arg (char *a, int i)
{
if (gnat_argv != NULL)
strncpy (a, gnat_argv[i], strlen(gnat_argv[i]));
}
......@@ -101,11 +105,15 @@ __gnat_env_count (void)
int
__gnat_len_env (int env_num)
{
if (gnat_envp != NULL)
return strlen (gnat_envp[env_num]);
else
return 0;
}
void
__gnat_fill_env (char *a, int i)
{
if (gnat_envp != NULL)
strncpy (a, gnat_envp[i], strlen (gnat_envp[i]));
}
gcc/ada/bcheck.adb
......@@ -202,7 +202,7 @@ package body Bcheck is
elsif Tolerate_Consistency_Errors then
Error_Msg
("?% should be recompiled (% has been modified)");
("?{ should be recompiled ({ has been modified)");
else
Error_Msg ("{ must be recompiled ({ has been modified)");
......
gcc/ada/cstand.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
......@@ -948,7 +948,8 @@ package body CStand is
Set_Ekind (Any_Id, E_Variable);
Set_Scope (Any_Id, Standard_Standard);
Set_Etype (Any_Id, Any_Type);
Init_Size_Align (Any_Id);
Init_Esize (Any_Id);
Init_Alignment (Any_Id);
Make_Name (Any_Id, "any id");
Any_Access := New_Standard_Entity;
......
gcc/ada/exp_ch13.adb
......@@ -86,6 +86,7 @@ package body Exp_Ch13 is
-- original node is in the source. An exception though is the case
-- of an access variable which is default initialized to null, and
-- such initialization is retained.
-- Furthermore, if the initialization is the equivalent aggregate
-- of the type initialization procedure, it replaces an implicit
-- call to the init proc, and must be respected. Note that for
......
gcc/ada/exp_ch5.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- --
......@@ -37,5 +37,5 @@ package Exp_Ch5 is
procedure Expand_N_Goto_Statement (N : Node_Id);
procedure Expand_N_If_Statement (N : Node_Id);
procedure Expand_N_Loop_Statement (N : Node_Id);
procedure Expand_N_Return_Statement (N : Node_Id);
procedure Expand_N_Simple_Return_Statement (N : Node_Id);
end Exp_Ch5;
gcc/ada/exp_dbug.adb
......@@ -673,7 +673,7 @@ package body Exp_Dbug is
-- If the front end has already computed a fully qualified name,
-- then it is also the case that no further qualification is
-- required
-- required.
if Present (Scope (Scope (Entity)))
and then not Has_Fully_Qualified_Name (Entity)
......@@ -1331,6 +1331,9 @@ package body Exp_Dbug is
procedure Strip_Suffixes (BNPE_Suffix_Found : in out Boolean) is
SL : Natural;
pragma Warnings (Off, BNPE_Suffix_Found);
-- Since this procedure only ever sets the flag
begin
-- Search for and strip BNPE suffix
......
gcc/ada/exp_strm.adb
......@@ -219,7 +219,7 @@ package body Exp_Strm is
Make_Identifier (Loc, Name_S),
Make_Identifier (Loc, Name_V))),
Make_Return_Statement (Loc,
Make_Simple_Return_Statement (Loc,
Expression => Make_Identifier (Loc, Name_V)));
Fnam :=
......@@ -1158,7 +1158,7 @@ package body Exp_Strm is
Make_Identifier (Loc, Name_S),
Make_Identifier (Loc, Name_V))),
Make_Return_Statement (Loc,
Make_Simple_Return_Statement (Loc,
Expression => Make_Identifier (Loc, Name_V)));
Fnam := Make_Stream_Subprogram_Name (Loc, Typ, TSS_Stream_Input);
......
gcc/ada/expander.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
......@@ -379,8 +379,8 @@ package body Expander is
when N_Requeue_Statement =>
Expand_N_Requeue_Statement (N);
when N_Return_Statement =>
Expand_N_Return_Statement (N);
when N_Simple_Return_Statement =>
Expand_N_Simple_Return_Statement (N);
when N_Selected_Component =>
Expand_N_Selected_Component (N);
......
gcc/ada/g-altcon.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2005-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- --
......@@ -78,7 +78,7 @@ package body GNAT.Altivec.Conversions is
-- relying on internal knowledge about the bits layout in the different
-- types (all 128 value bits blocks).
-- View<->Vector straight bitwise conversions on BE targets.
-- View<->Vector straight bitwise conversions on BE targets
function UNC_To_Vector is
new Ada.Unchecked_Conversion (View_Type, Vector_Type);
......@@ -86,7 +86,7 @@ package body GNAT.Altivec.Conversions is
function UNC_To_View is
new Ada.Unchecked_Conversion (Vector_Type, View_Type);
-- Varray->Vector/View for returning mirrored results on LE targets.
-- Varray->Vector/View for returning mirrored results on LE targets
function UNC_To_Vector is
new Ada.Unchecked_Conversion (Varray_Type, Vector_Type);
......@@ -94,7 +94,7 @@ package body GNAT.Altivec.Conversions is
function UNC_To_View is
new Ada.Unchecked_Conversion (Varray_Type, View_Type);
-- Vector/View->Varray for to-be-permuted source on LE targets.
-- Vector/View->Varray for to-be-permuted source on LE targets
function UNC_To_Varray is
new Ada.Unchecked_Conversion (Vector_Type, Varray_Type);
......
gcc/ada/g-dirope.adb
......@@ -647,7 +647,7 @@ package body GNAT.Directory_Operations is
----------
procedure Read
(Dir : in out Dir_Type;
(Dir : Dir_Type;
Str : out String;
Last : out Natural)
is
......
gcc/ada/g-dirope.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2005, AdaCore --
-- Copyright (C) 1998-2007, AdaCore --
-- --
-- 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- --
......@@ -230,7 +230,7 @@ package GNAT.Directory_Operations is
-- Returns True if Dir is open, or False otherwise
procedure Read
(Dir : in out Dir_Type;
(Dir : Dir_Type;
Str : out String;
Last : out Natural);
-- Reads the next entry from the directory and sets Str to the name
......
gcc/ada/g-eacodu.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003 Free Software Foundation, Inc. --
-- Copyright (C) 2003-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- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is the default (Unix) version.
-- This is the default (Unix) version
separate (GNAT.Exception_Actions)
procedure Core_Dump (Occurrence : Exception_Occurrence) is
......
gcc/ada/itypes.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, 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- --
......@@ -74,6 +74,12 @@ package Itypes is
-- call to New_Copy_Tree is to create a complete duplicate of a tree,
-- as though it had appeared separately in the source), the Itype in
-- question is duplicated as part of the New_Copy_Tree processing.
-- As a consequence of this copying mechanism, the association between
-- itypes and associated nodes must be one-to-one: several itypes must
-- not share an associated node. For example, the semantic decoration
-- of an array aggregate generates several itypes: for each index subtype
-- and for the array subtype. The associated node of each index subtype
-- is the corresponding range expression.
-----------------
-- Subprograms --
......
gcc/ada/par-ch12.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
......@@ -332,7 +332,7 @@ package body Ch12 is
begin
Generic_Assoc_Node := New_Node (N_Generic_Association, Token_Ptr);
-- Ada2005: an association can be given by: others => <>.
-- Ada2005: an association can be given by: others => <>
if Token = Tok_Others then
if Ada_Version < Ada_05 then
......@@ -375,7 +375,7 @@ package body Ch12 is
end if;
end if;
-- In Ada 2005 the actual can be a box.
-- In Ada 2005 the actual can be a box
if Token = Tok_Box then
Scan;
......
gcc/ada/par-ch2.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, 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- --
......@@ -177,7 +177,7 @@ package body Ch2 is
-- CHARACTER_LITERAL ::= ' GRAPHIC_CHARACTER '
-- Handled by the scanner and returned as Tok_Character_Literal
-- Handled by the scanner and returned as Tok_Char_Literal
-------------------------
-- 2.6 String Literal --
......@@ -185,7 +185,7 @@ package body Ch2 is
-- STRING LITERAL ::= "{STRING_ELEMENT}"
-- Handled by the scanner and returned as Tok_Character_Literal
-- Handled by the scanner and returned as Tok_String_Literal
-- or if the string looks like an operator as Tok_Operator_Symbol.
-------------------------
......@@ -479,7 +479,7 @@ package body Ch2 is
if Identifier_Seen then
Error_Msg_SC
("|pragma argument identifier required here ('R'M' 2.8(4))");
("|pragma argument identifier required here (RM 2.8(4))");
end if;
end if;
end if;
......
gcc/ada/s-asthan-vms-alpha.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2006 Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is the OpenVMS/Alpha version.
-- This is the OpenVMS/Alpha version
with System; use System;
......@@ -205,7 +205,7 @@ package body System.AST_Handling is
end record;
AST_Vector_Init : AST_Vector_Ptr;
-- Initial value, treated as constant, Vector will be null.
-- Initial value, treated as constant, Vector will be null
package AST_Attribute is new Ada.Task_Attributes
(Attribute => AST_Vector_Ptr,
......@@ -241,7 +241,7 @@ package body System.AST_Handling is
AST_Service_Queue : array (AST_Service_Queue_Index) of AST_Instance;
pragma Volatile_Components (AST_Service_Queue);
-- The circular buffer used to store active AST requests.
-- The circular buffer used to store active AST requests
AST_Service_Queue_Put : AST_Service_Queue_Index := 0;
AST_Service_Queue_Get : AST_Service_Queue_Index := 0;
......@@ -583,7 +583,7 @@ package body System.AST_Handling is
if Is_Waiting (J) then
Is_Waiting (J) := False;
-- Sleeps are handled by ASTs on VMS, so don't call Wakeup.
-- Sleeps are handled by ASTs on VMS, so don't call Wakeup
STPOD.Interrupt_AST_Handler (To_Address (AST_Task_Ids (J)));
exit;
......
gcc/ada/s-direio.adb
......@@ -319,6 +319,10 @@ package body System.Direct_IO is
procedure Do_Write;
-- Do the actual write
--------------
-- Do_Write --
--------------
procedure Do_Write is
begin
FIO.Write_Buf (AP (File), Item, Size);
......
gcc/ada/s-except.ads
......@@ -42,7 +42,7 @@ package System.Exceptions is
pragma Warnings (Off);
pragma Preelaborate_05;
pragma Warnings (On);
-- To let Ada.Exceptions "with" us and let us "with" Standard_Library.
-- To let Ada.Exceptions "with" us and let us "with" Standard_Library
package SSL renames System.Standard_Library;
-- To let some of the hooks below have formal parameters typed in
......
gcc/ada/s-htable.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2005 AdaCore --
-- Copyright (C) 1995-2007, AdaCore --
-- --
-- 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- --
......@@ -54,7 +54,7 @@ package System.HTable is
generic
type Header_Num is range <>;
-- An integer type indicating the number and range of hash headers.
-- An integer type indicating the number and range of hash headers
type Element is private;
-- The type of element to be stored
......@@ -120,7 +120,7 @@ package System.HTable is
generic
type Header_Num is range <>;
-- An integer type indicating the number and range of hash headers.
-- An integer type indicating the number and range of hash headers
type Element (<>) is limited private;
-- The type of element to be stored. This is historically part of the
......@@ -137,7 +137,7 @@ package System.HTable is
-- type, but could be some other form of type such as an integer type).
Null_Ptr : Elmt_Ptr;
-- The null value of the Elmt_Ptr type.
-- The null value of the Elmt_Ptr type
with procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
with function Next (E : Elmt_Ptr) return Elmt_Ptr;
......
gcc/ada/s-imgboo.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 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,6 +37,6 @@ package System.Img_Bool is
pragma Pure;
function Image_Boolean (V : Boolean) return String;
-- Computes Boolean'Image (V) and returns the result.
-- Computes Boolean'Image (V) and returns the result
end System.Img_Bool;
gcc/ada/s-imglli.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 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- --
......@@ -39,7 +39,7 @@ package System.Img_LLI is
pragma Preelaborate;
function Image_Long_Long_Integer (V : Long_Long_Integer) return String;
-- Computes Long_Long_Integer'Image (V) and returns the result.
-- Computes Long_Long_Integer'Image (V) and returns the result
procedure Set_Image_Long_Long_Integer
(V : Long_Long_Integer;
......
gcc/ada/s-imgllu.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 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- --
......@@ -43,7 +43,7 @@ package System.Img_LLU is
function Image_Long_Long_Unsigned
(V : System.Unsigned_Types.Long_Long_Unsigned)
return String;
-- Computes Long_Long_Unsigned'Image (V) and returns the result.
-- Computes Long_Long_Unsigned'Image (V) and returns the result
procedure Set_Image_Long_Long_Unsigned
(V : System.Unsigned_Types.Long_Long_Unsigned;
......
gcc/ada/s-imguns.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 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- --
......@@ -43,7 +43,7 @@ package System.Img_Uns is
function Image_Unsigned
(V : System.Unsigned_Types.Unsigned)
return String;
-- Computes Unsigned'Image (V) and returns the result.
-- Computes Unsigned'Image (V) and returns the result
procedure Set_Image_Unsigned
(V : System.Unsigned_Types.Unsigned;
......
gcc/ada/s-inmaop-vms.adb
......@@ -283,6 +283,8 @@ package body System.Interrupt_Management.Operations is
P1 => To_unsigned_long (Interrupt'Address),
P2 => Interrupt_ID'Size / 8);
-- The following could use a comment ???
pragma Assert ((Status and 1) = 1);
end Interrupt_Self_Process;
......
gcc/ada/s-interr.adb
......@@ -257,7 +257,7 @@ package body System.Interrupts is
Registered_Handler_Tail : R_Link := null;
Access_Hold : Server_Task_Access;
-- variable used to allocate Server_Task using "new".
-- Variable used to allocate Server_Task using "new"
-----------------------
-- Local Subprograms --
......@@ -920,7 +920,7 @@ package body System.Interrupts is
if New_Handler = null then
-- The null handler means we are detaching the handler.
-- The null handler means we are detaching the handler
User_Handler (Interrupt).Static := False;
......@@ -1267,18 +1267,18 @@ package body System.Interrupts is
System.Tasking.Utilities.Make_Independent;
-- Install default action in system level.
-- Install default action in system level
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
-- Note: All tasks in RTS will have all the Reserve Interrupts
-- being masked (except the Interrupt_Manager) and Keep_Unmasked
-- unmasked when created.
-- Note: All tasks in RTS will have all the Reserve Interrupts being
-- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked when
-- created.
-- Abort_Task_Interrupt is one of the Interrupt unmasked
-- in all tasks. We mask the Interrupt in this particular task
-- so that "sigwait" is possible to catch an explicitely sent
-- Abort_Task_Interrupt from the Interrupt_Manager.
-- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
-- We mask the Interrupt in this particular task so that "sigwait" is
-- possible to catch an explicitely sent Abort_Task_Interrupt from the
-- Interrupt_Manager.
-- There are two Interrupt interrupts that this task catch through
-- "sigwait." One is the Interrupt this task is designated to catch
......@@ -1287,7 +1287,7 @@ package body System.Interrupts is
-- Interrupt_Manager to inform status changes (e.g: become Blocked,
-- Handler or Entry is to be detached).
-- Prepare a mask to used for sigwait.
-- Prepare a mask to used for sigwait
IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
......@@ -1361,7 +1361,7 @@ package body System.Interrupts is
if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
-- Inform the Interrupt_Manager of wakeup from above sigwait.
-- Inform the Interrupt_Manager of wakeup from above sigwait
POP.Abort_Task (Interrupt_Manager_ID);
......@@ -1397,7 +1397,7 @@ package body System.Interrupts is
if User_Handler (Interrupt).H /= null then
Tmp_Handler := User_Handler (Interrupt).H;
-- RTS calls should not be made with self being locked.
-- RTS calls should not be made with self being locked
POP.Unlock (Self_ID);
......@@ -1417,7 +1417,7 @@ package body System.Interrupts is
Tmp_ID := User_Entry (Interrupt).T;
Tmp_Entry_Index := User_Entry (Interrupt).E;
-- RTS calls should not be made with self being locked.
-- RTS calls should not be made with self being locked
if Single_Lock then
POP.Unlock_RTS;
......@@ -1470,7 +1470,7 @@ package body System.Interrupts is
-- Elaboration code for package System.Interrupts
begin
-- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
-- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
......
gcc/ada/s-interr.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. --
-- --
-- GNARL 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- --
......@@ -134,7 +134,7 @@ package System.Interrupts is
-- already bound to another entry, Program_Error will be raised.
procedure Detach_Interrupt_Entries (T : System.Tasking.Task_Id);
-- This procedure detaches all the Interrupt Entries bound to a task.
-- This procedure detaches all the Interrupt Entries bound to a task
------------------------------
-- POSIX.5 Signals Services --
......@@ -157,7 +157,7 @@ package System.Interrupts is
-- Comment needed ???
procedure Ignore_Interrupt (Interrupt : Interrupt_ID);
-- Set the sigacion for the interrupt to SIG_IGN.
-- Set the sigacion for the interrupt to SIG_IGN
procedure Unignore_Interrupt (Interrupt : Interrupt_ID);
-- Comment needed ???
......
gcc/ada/s-intman-dummy.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is a NO tasking version of this package.
-- This is a NO tasking version of this package
package body System.Interrupt_Management is
......
gcc/ada/s-intman-irix.adb
......@@ -6,8 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2006, AdaCore --
-- Copyright (C) 1995-2007, AdaCore --
-- --
-- GNARL 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- --
......@@ -32,13 +31,11 @@
-- --
------------------------------------------------------------------------------
-- This is a SGI Pthread version of this package.
-- This is a SGI Pthread version of this package
-- Make a careful study of all signals available under the OS,
-- to see which need to be reserved, kept always unmasked,
-- or kept always unmasked.
-- Be on the lookout for special signals that
-- may be used by the thread library.
-- Make a careful study of all signals available under the OS, to see which
-- need to be reserved, kept always unmasked, or kept always unmasked. Be on
-- the lookout for special signals that may be used by the thread library.
package body System.Interrupt_Management is
......
gcc/ada/s-intman-vms.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is a OpenVMS/Alpha version of this package.
-- This is a OpenVMS/Alpha version of this package
package body System.Interrupt_Management is
......
gcc/ada/s-intman-vms.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -67,11 +67,9 @@ package System.Interrupt_Management is
-- all systems, but is always reserved when it is defined. If we have the
-- convention that ID zero is not used for any "real" signals, and SIGRARE
-- = 0 when SIGRARE is not one of the locally supported signals, we can
-- write
-- write:
-- Reserved (SIGRARE) := true;
-- Then the initialization code will be portable
-- Then the initialization code will be portable.
Abort_Task_Interrupt : Interrupt_ID;
-- The interrupt that is used to implement task abort, if an interrupt is
......
gcc/ada/s-intman-vxworks.adb
......@@ -31,13 +31,11 @@
-- --
------------------------------------------------------------------------------
-- This is the VxWorks version of this package.
-- This is the VxWorks version of this package
-- Make a careful study of all signals available under the OS,
-- to see which need to be reserved, kept always unmasked,
-- or kept always unmasked.
-- Be on the lookout for special signals that
-- may be used by the thread library.
-- Make a careful study of all signals available under the OS, to see which
-- need to be reserved, kept always unmasked, or kept always unmasked. Be on
-- the lookout for special signals that may be used by the thread library.
package body System.Interrupt_Management is
......@@ -62,9 +60,8 @@ package body System.Interrupt_Management is
function State (Int : Interrupt_ID) return Character;
pragma Import (C, State, "__gnat_get_interrupt_state");
-- Get interrupt state. Defined in init.c
-- The input argument is the interrupt number,
-- and the result is one of the following:
-- Get interrupt state. Defined in init.c The input argument is the
-- interrupt number, and the result is one of the following:
Runtime : constant Character := 'r';
Default : constant Character := 's';
......
gcc/ada/s-intman-vxworks.ads
......@@ -78,9 +78,7 @@ package System.Interrupt_Management is
-- convention that ID zero is not used for any "real" signals, and SIGRARE
-- = 0 when SIGRARE is not one of the locally supported signals, we can
-- write:
-- Reserved (SIGRARE) := true;
-- and the initialization code will be portable.
Abort_Task_Interrupt : Signal_ID;
......
gcc/ada/s-mastop.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1999-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- --
......@@ -88,8 +88,17 @@ package System.Machine_State_Operations is
-- Some architectures (notably VMS) use a descriptor to describe
-- a subprogram address. This function computes the actual starting
-- address of the code from Loc.
-- Do not add pragma Inline, see 9116-002.
--
-- ??? This function will go away when 'Code_Address is fixed on VMS.
--
-- Do not add pragma Inline to this function: there is a curious
-- interaction between rtsfind and front-end inlining. The exception
-- declaration in s-auxdec calls rtsfind, which forces several other system
-- packages to be compiled. Some of those have a pragma Inline, and we
-- compile the corresponding bodies so that inlining can take place. One
-- of these packages is s-mastop, which depends on s-auxdec, which is still
-- being compiled: we have not seen all the declarations in it yet, so we
-- get confused semantic errors.
procedure Set_Machine_State (M : Machine_State);
-- This routine sets M from the current machine state. It is called
......
gcc/ada/s-osinte-darwin.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -32,14 +32,13 @@
-- --
------------------------------------------------------------------------------
-- This is Darwin pthreads version of this package.
-- This is Darwin pthreads version of this package
-- This package includes all direct interfaces to OS services
-- that are needed by children of System.
-- This package includes all direct interfaces to OS services that are needed
-- by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Elaborate_Body. It is designed to be a bottom-level (leaf) package.
with Interfaces.C;
package System.OS_Interface is
......@@ -174,7 +173,7 @@ package System.OS_Interface is
----------
Time_Slice_Supported : constant Boolean := True;
-- Indicates wether time slicing is supported.
-- Indicates wether time slicing is supported
type timespec is private;
......@@ -210,7 +209,7 @@ package System.OS_Interface is
function To_Target_Priority
(Prio : System.Any_Priority) return Interfaces.C.int;
-- Maps System.Any_Priority to a POSIX priority.
-- Maps System.Any_Priority to a POSIX priority
-------------
-- Process --
......
gcc/ada/s-osinte-hpux-dce.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1995-2007, AdaCore --
-- --
-- GNARL 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- --
......@@ -126,7 +126,7 @@ package body System.OS_Interface is
return 0;
end sigwait;
-- DCE_THREADS does not have pthread_kill. Instead, we just ignore it.
-- DCE_THREADS does not have pthread_kill. Instead, we just ignore it
function pthread_kill (thread : pthread_t; sig : Signal) return int is
pragma Unreferenced (thread, sig);
......
gcc/ada/s-osinte-hpux-dce.ads
......@@ -291,9 +291,8 @@ package System.OS_Interface is
(how : int;
set : access sigset_t;
oset : access sigset_t) return int;
-- DCE THREADS does not have pthread_sigmask. Instead, it uses
-- sigprocmask to do the signal handling when the thread library is
-- sucked in.
-- DCE THREADS does not have pthread_sigmask. Instead, it uses sigprocmask
-- to do the signal handling when the thread library is sucked in.
pragma Import (C, pthread_sigmask, "sigprocmask");
--------------------------
......@@ -302,7 +301,7 @@ package System.OS_Interface is
function pthread_mutexattr_init
(attr : access pthread_mutexattr_t) return int;
-- DCE_THREADS has a nonstandard pthread_mutexattr_init.
-- DCE_THREADS has a nonstandard pthread_mutexattr_init
function pthread_mutexattr_destroy
(attr : access pthread_mutexattr_t) return int;
......
gcc/ada/s-osinte-irix.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -31,14 +31,14 @@
-- --
------------------------------------------------------------------------------
-- This is the IRIX version of this package.
-- This is the IRIX version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This package encapsulates all direct interfaces to OS services that are
-- needed by children of System.
pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with Interfaces.C; use Interfaces.C;
......
gcc/ada/s-osinte-irix.ads
......@@ -119,7 +119,7 @@ package System.OS_Interface is
SIGCKPT : constant := 33; -- Checkpoint warning
SIGRESTART : constant := 34; -- Restart warning
SIGUME : constant := 35; -- Uncorrectable memory error
-- Signals defined for Posix 1003.1c.
-- Signals defined for Posix 1003.1c
SIGPTINTR : constant := 47;
SIGPTRESCHED : constant := 48;
-- Posix 1003.1b signals
......
gcc/ada/s-osprim-mingw.adb
......@@ -99,7 +99,7 @@ package body System.OS_Primitives is
Base_Ticks : aliased LARGE_INTEGER;
BTA : constant LIA := Base_Ticks'Access;
-- Holds the Tick count for the base time.
-- Holds the Tick count for the base time
Base_Monotonic_Ticks : aliased LARGE_INTEGER;
BMTA : constant LIA := Base_Monotonic_Ticks'Access;
......@@ -160,8 +160,8 @@ package body System.OS_Primitives is
-- If we have a shift of more than Max_Shift seconds we resynchonize the
-- Clock. This is probably due to a manual Clock adjustment, an DST
-- adjustment or an NTP synchronisation. And we want to adjust the
-- time for this system (non-monotonic) clock.
-- adjustment or an NTP synchronisation. And we want to adjust the time
-- for this system (non-monotonic) clock.
if abs (Elap_Secs_Sys - Elap_Secs_Tick) > Max_Shift then
Get_Base_Time;
......@@ -180,7 +180,7 @@ package body System.OS_Primitives is
procedure Get_Base_Time is
-- The resolution for GetSystemTime is 1 millisecond.
-- The resolution for GetSystemTime is 1 millisecond
-- The time to get both base times should take less than 1 millisecond.
-- Therefore, the elapsed time reported by GetSystemTime between both
......
gcc/ada/s-parame-ae653.ads
......@@ -193,7 +193,7 @@ package System.Parameters is
-----------------------
Max_Task_Image_Length : constant := 32;
-- This constant specifies the maximum length of a task's image.
-- This constant specifies the maximum length of a task's image
------------------------------
-- Exception Message Length --
......
gcc/ada/s-parame-hpux.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007 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- --
......@@ -191,7 +191,7 @@ package System.Parameters is
-----------------------
Max_Task_Image_Length : constant := 256;
-- This constant specifies the maximum length of a task's image.
-- This constant specifies the maximum length of a task's image
------------------------------
-- Exception Message Length --
......
gcc/ada/s-parame-vms-alpha.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007 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- --
......@@ -191,7 +191,7 @@ package System.Parameters is
-----------------------
Max_Task_Image_Length : constant := 256;
-- This constant specifies the maximum length of a task's image.
-- This constant specifies the maximum length of a task's image
------------------------------
-- Exception Message Length --
......
gcc/ada/s-parame-vms-ia64.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007 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- --
......@@ -191,7 +191,7 @@ package System.Parameters is
-----------------------
Max_Task_Image_Length : constant := 256;
-- This constant specifies the maximum length of a task's image.
-- This constant specifies the maximum length of a task's image
------------------------------
-- Exception Message Length --
......
gcc/ada/s-parame-vms-restrict.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007 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- --
......@@ -191,7 +191,7 @@ package System.Parameters is
-----------------------
Max_Task_Image_Length : constant := 256;
-- This constant specifies the maximum length of a task's image.
-- This constant specifies the maximum length of a task's image
------------------------------
-- Exception Message Length --
......
gcc/ada/s-parame-vxworks.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1995-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- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- Version used on all VxWorks targets.
-- Version used on all VxWorks targets
package body System.Parameters is
......
gcc/ada/s-parame-vxworks.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007 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- --
......@@ -193,7 +193,7 @@ package System.Parameters is
-----------------------
Max_Task_Image_Length : constant := 32;
-- This constant specifies the maximum length of a task's image.
-- This constant specifies the maximum length of a task's image
------------------------------
-- Exception Message Length --
......
gcc/ada/s-parame.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007 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- --
......@@ -191,7 +191,7 @@ package System.Parameters is
-----------------------
Max_Task_Image_Length : constant := 256;
-- This constant specifies the maximum length of a task's image.
-- This constant specifies the maximum length of a task's image
------------------------------
-- Exception Message Length --
......
gcc/ada/s-poosiz.adb
......@@ -40,12 +40,11 @@ package body System.Pool_Size is
package SSE renames System.Storage_Elements;
use type SSE.Storage_Offset;
-- Even though these storage pools are typically only used
-- by a single task, if multiple tasks are declared at the
-- same or a more nested scope as the storage pool, there
-- still may be concurrent access. The current implementation
-- of Stack_Bounded_Pool always uses a global lock for protecting
-- access. This should eventually be replaced by an atomic
-- Even though these storage pools are typically only used by a single
-- task, if multiple tasks are declared at the same or a more nested scope
-- as the storage pool, there still may be concurrent access. The current
-- implementation of Stack_Bounded_Pool always uses a global lock for
-- protecting access. This should eventually be replaced by an atomic
-- linked list implementation for efficiency reasons.
package SSL renames System.Soft_Links;
......@@ -58,9 +57,9 @@ package body System.Pool_Size is
package Variable_Size_Management is
-- Embedded pool that manages allocation of variable-size data.
-- Embedded pool that manages allocation of variable-size data
-- This pool is used as soon as the Elmt_sizS of the pool object is 0.
-- This pool is used as soon as the Elmt_sizS of the pool object is 0
-- Allocation is done on the first chunk long enough for the request.
-- Deallocation just puts the freed chunk at the beginning of the list.
......
gcc/ada/s-proinf-irix-athread.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1997-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- --
......@@ -31,20 +31,19 @@
-- --
------------------------------------------------------------------------------
-- This package contains the definitions and routines used as parameters
-- to the run-time system at program startup for the SGI implementation.
-- This package contains the definitions and routines used as parameters to
-- the run-time system at program startup for the SGI implementation.
package System.Program_Info is
pragma Preelaborate;
function Initial_Sproc_Count return Integer;
-- The number of sproc created at program startup for scheduling
-- threads.
-- The number of sproc created at program startup for scheduling threads
function Max_Sproc_Count return Integer;
-- The maximum number of sprocs that can be created by the program
-- for servicing threads. This limit includes both the pre-created
-- sprocs and those explicitly created under program control.
-- The maximum number of sprocs that can be created by the program for
-- servicing threads. This limit includes both the pre-created sprocs and
-- those explicitly created under program control.
function Sproc_Stack_Size return Integer;
-- The size, in bytes, of the sproc's initial stack.
......@@ -56,9 +55,9 @@ package System.Program_Info is
-- Task_Info pragma. See s-tasinf.ads for more information.
function Default_Task_Stack return Integer;
-- The default stack size for each created thread. This default value
-- can be overriden on a per-task basis by the language-defined
-- Storage_Size pragma.
-- The default stack size for each created thread. This default value can
-- be overriden on a per-task basis by the language-defined Storage_Size
-- pragma.
function Stack_Guard_Pages return Integer;
-- The number of non-writable, guard pages to append to the bottom of
......
gcc/ada/s-stache.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1999-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -73,7 +73,7 @@ private
(Limit => System.Null_Address,
Base => System.Null_Address,
Size => 0);
-- Use explicit assignment to avoid elaboration code (call to init proc).
-- Use explicit assignment to avoid elaboration code (call to init proc)
Null_Stack : constant Stack_Access := Null_Stack_Info'Access;
-- Stack_Access value that will return a Stack_Base and Stack_Limit
......
gcc/ada/s-stausa.adb
......@@ -353,6 +353,7 @@ package body System.Stack_Usage is
Task_Name_Blanks :
constant String (1 .. Task_Name_Length - Task_Name_Str'Length) :=
(others => ' ');
begin
Set_Output (Standard_Error);
......@@ -362,6 +363,7 @@ package body System.Stack_Usage is
end if;
if Result_Array'Length > 0 then
-- Computes the size of the largest strings that will get displayed,
-- in order to do correct column alignment.
......
gcc/ada/s-tasinf-solaris.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 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- --
......@@ -34,14 +34,13 @@
-- This package body contains the routines associated with the implementation
-- of the Task_Info pragma.
-- This is the Solaris (native) version of this module.
-- This is the Solaris (native) version of this module
package body System.Task_Info is
function Unbound_Thread_Attributes return Thread_Attributes is
begin
return (False, False);
end Unbound_Thread_Attributes;
-----------------------------
-- Bound_Thread_Attributes --
-----------------------------
function Bound_Thread_Attributes return Thread_Attributes is
begin
......@@ -54,10 +53,9 @@ package body System.Task_Info is
return (True, True, CPU);
end Bound_Thread_Attributes;
function New_Unbound_Thread_Attributes return Task_Info_Type is
begin
return new Thread_Attributes'(False, False);
end New_Unbound_Thread_Attributes;
---------------------------------
-- New_Bound_Thread_Attributes --
---------------------------------
function New_Bound_Thread_Attributes return Task_Info_Type is
begin
......@@ -70,4 +68,22 @@ package body System.Task_Info is
return new Thread_Attributes'(True, True, CPU);
end New_Bound_Thread_Attributes;
-----------------------------------
-- New_Unbound_Thread_Attributes --
-----------------------------------
function New_Unbound_Thread_Attributes return Task_Info_Type is
begin
return new Thread_Attributes'(False, False);
end New_Unbound_Thread_Attributes;
-------------------------------
-- Unbound_Thread_Attributes --
-------------------------------
function Unbound_Thread_Attributes return Thread_Attributes is
begin
return (False, False);
end Unbound_Thread_Attributes;
end System.Task_Info;
gcc/ada/s-tasinf-solaris.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 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- --
......@@ -41,7 +41,7 @@
-- This unit may be used directly from an application program by providing
-- an appropriate WITH, and the interface can be expected to remain stable.
-- This is the Solaris (native) version of this module.
-- This is the Solaris (native) version of this module
with System.OS_Interface;
......@@ -84,7 +84,7 @@ package System.Task_Info is
-- The Task_Info pragma appears within a task definition (compare the
-- definition and implementation of pragma Priority). If no such pragma
-- appears, then the value Task_Info_Unspecified is passed. If a pragma
-- appears, then the value Unspecified_Task_Info is passed. If a pragma
-- is present, then it supplies an alternative value. If the argument of
-- the pragma is a discriminant reference, then the value can be set on
-- a task by task basis by supplying the appropriate discriminant value.
......
gcc/ada/s-tasinf-tru64.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- (Compiler Interface) --
-- --
-- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1998-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- --
......@@ -42,7 +42,7 @@
-- This unit may be used directly from an application program by providing
-- an appropriate WITH, and the interface can be expected to remain stable.
-- This is a DEC Unix 4.0d version of this package.
-- This is a DEC Unix 4.0d version of this package
package System.Task_Info is
pragma Preelaborate;
......@@ -64,7 +64,7 @@ package System.Task_Info is
-- The Task_Info pragma appears within a task definition (compare the
-- definition and implementation of pragma Priority). If no such pragma
-- appears, then the value Task_Info_Unspecified is passed. If a pragma
-- appears, then the value Unspecified_Task_Info is passed. If a pragma
-- is present, then it supplies an alternative value. If the argument of
-- the pragma is a discriminant reference, then the value can be set on
-- a task by task basis by supplying the appropriate discriminant value.
......
gcc/ada/s-tasinf.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 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- --
......@@ -61,7 +61,7 @@ package System.Task_Info is
-- The Task_Info pragma appears within a task definition (compare the
-- definition and implementation of pragma Priority). If no such pragma
-- appears, then the value Task_Info_Unspecified is passed. If a pragma
-- appears, then the value Unspecified_Task_Info is passed. If a pragma
-- is present, then it supplies an alternative value. If the argument of
-- the pragma is a discriminant reference, then the value can be set on
-- a task by task basis by supplying the appropriate discriminant value.
......
gcc/ada/s-tfsetr-vxworks.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -31,11 +31,11 @@
-- --
------------------------------------------------------------------------------
-- This version is for VxWorks targets.
-- This version is for VxWorks targets
-- Trace information is sent to WindView using the wvEvent function.
-- Trace information is sent to WindView using the wvEvent function
-- Note that wvEvent is from the VxWorks API.
-- Note that wvEvent is from the VxWorks API
-- When adding a new event, just give an Id to then event, and then modify
-- the WindView events database.
......
gcc/ada/scng.adb
......@@ -571,7 +571,7 @@ package body Scng is
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?");
("use of "":"" is an obsolescent feature (RM J.2(3))?");
Error_Msg_S
("\use ""'#"" instead?");
end if;
......@@ -1178,7 +1178,10 @@ package body Scng is
-- Horizontal tab, just skip past it
when HT =>
if Style_Check then Style.Check_HT; end if;
if Style_Check then
Style.Check_HT;
end if;
Scan_Ptr := Scan_Ptr + 1;
-- End of file character, treated as an end of file only if it is
......@@ -1187,7 +1190,11 @@ package body Scng is
when EOF =>
if Scan_Ptr = Source_Last (Current_Source_File) then
Check_End_Of_Line;
if Style_Check then Style.Check_EOF; end if;
if Style_Check then
Style.Check_EOF;
end if;
Token := Tok_EOF;
return;
else
......@@ -1237,7 +1244,11 @@ package body Scng is
if Double_Char_Token ('=') then
Token := Tok_Colon_Equal;
if Style_Check then Style.Check_Colon_Equal; end if;
if Style_Check then
Style.Check_Colon_Equal;
end if;
return;
elsif Source (Scan_Ptr + 1) = '-'
......@@ -1251,7 +1262,11 @@ package body Scng is
else
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Colon;
if Style_Check then Style.Check_Colon; end if;
if Style_Check then
Style.Check_Colon;
end if;
return;
end if;
......@@ -1261,7 +1276,11 @@ package body Scng is
Accumulate_Checksum ('(');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Left_Paren;
if Style_Check then Style.Check_Left_Paren; end if;
if Style_Check then
Style.Check_Left_Paren;
end if;
return;
-- Left bracket
......@@ -1291,7 +1310,11 @@ package body Scng is
Accumulate_Checksum (',');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Comma;
if Style_Check then Style.Check_Comma; end if;
if Style_Check then
Style.Check_Comma;
end if;
return;
-- Dot, which is either an isolated period, or part of a double dot
......@@ -1303,7 +1326,11 @@ package body Scng is
if Double_Char_Token ('.') then
Token := Tok_Dot_Dot;
if Style_Check then Style.Check_Dot_Dot; end if;
if Style_Check then
Style.Check_Dot_Dot;
end if;
return;
elsif Source (Scan_Ptr + 1) in '0' .. '9' then
......@@ -1324,7 +1351,11 @@ package body Scng is
if Double_Char_Token ('>') then
Token := Tok_Arrow;
if Style_Check then Style.Check_Arrow; end if;
if Style_Check then
Style.Check_Arrow;
end if;
return;
elsif Source (Scan_Ptr + 1) = '=' then
......@@ -1369,7 +1400,11 @@ package body Scng is
elsif Double_Char_Token ('>') then
Token := Tok_Box;
if Style_Check then Style.Check_Box; end if;
if Style_Check then
Style.Check_Box;
end if;
return;
elsif Double_Char_Token ('<') then
......@@ -1401,7 +1436,10 @@ package body Scng is
-- Comment
else -- Source (Scan_Ptr + 1) = '-' then
if Style_Check then Style.Check_Comment; end if;
if Style_Check then
Style.Check_Comment;
end if;
Scan_Ptr := Scan_Ptr + 2;
-- If we are in preprocessor mode with Replace_In_Comments set,
......@@ -1447,7 +1485,10 @@ package body Scng is
-- Keep going if horizontal tab
if Source (Scan_Ptr) = HT then
if Style_Check then Style.Check_HT; end if;
if Style_Check then
Style.Check_HT;
end if;
Scan_Ptr := Scan_Ptr + 1;
-- Terminate scan of comment if line terminator
......@@ -1538,7 +1579,7 @@ package body Scng is
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of ""'%"" is an obsolescent feature ('R'M 'J.2(4))?");
("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
Error_Msg_S
("\use """""" instead?");
end if;
......@@ -1581,7 +1622,11 @@ package body Scng is
or else Prev_Token in Token_Class_Literal
then
Token := Tok_Apostrophe;
if Style_Check then Style.Check_Apostrophe; end if;
if Style_Check then
Style.Check_Apostrophe;
end if;
return;
-- Otherwise the apostrophe starts a character literal
......@@ -1686,7 +1731,11 @@ package body Scng is
Accumulate_Checksum (')');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Right_Paren;
if Style_Check then Style.Check_Right_Paren; end if;
if Style_Check then
Style.Check_Right_Paren;
end if;
return;
-- Right bracket or right brace, treated as right paren
......@@ -1717,7 +1766,11 @@ package body Scng is
Accumulate_Checksum (';');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Semicolon;
if Style_Check then Style.Check_Semicolon; end if;
if Style_Check then
Style.Check_Semicolon;
end if;
return;
-- Vertical bar
......@@ -1736,7 +1789,11 @@ package body Scng is
else
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Vertical_Bar;
if Style_Check then Style.Check_Vertical_Bar; end if;
if Style_Check then
Style.Check_Vertical_Bar;
end if;
return;
end if;
end Vertical_Bar_Case;
......@@ -1749,7 +1806,7 @@ package body Scng is
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of ""'!"" is an obsolescent feature ('R'M 'J.2(2))?");
("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
Error_Msg_S
("\use ""'|"" instead?");
end if;
......@@ -2321,10 +2378,14 @@ package body Scng is
if Is_Keyword_Name (Token_Name) then
Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
-- Deal with possible style check for non-lower case keyword, but
-- we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords for
-- this purpose if they appear as attribute designators. Actually
-- we only check the first character for speed.
-- Keyword style checks
if Style_Check then
-- Deal with possible style check for non-lower case keyword,
-- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
-- for this purpose if they appear as attribute designators.
-- Actually we only check the first character for speed.
-- Ada 2005 (AI-284): Do not apply the style check in case of
-- "pragma Interface"
......@@ -2332,8 +2393,7 @@ package body Scng is
-- Ada 2005 (AI-340): Do not apply the style check in case of
-- MOD attribute.
if Style_Check
and then Source (Token_Ptr) <= 'Z'
if Source (Token_Ptr) <= 'Z'
and then (Prev_Token /= Tok_Apostrophe
or else
(Token /= Tok_Access and then
......@@ -2349,6 +2409,14 @@ package body Scng is
Style.Non_Lower_Case_Keyword;
end if;
if (Token = Tok_Then and then Prev_Token /= Tok_And)
or else
(Token = Tok_Else and then Prev_Token /= Tok_Or)
then
Style.Check_Separate_Stmt_Lines;
end if;
end if;
-- We must reset Token_Name since this is not an identifier and
-- if we leave Token_Name set, the parser gets confused because
-- it thinks it is dealing with an identifier instead of the
......@@ -2470,7 +2538,10 @@ package body Scng is
-- Outer loop keeps going only if a horizontal tab follows
if Source (Scan_Ptr) = HT then
if Style_Check then Style.Check_HT; end if;
if Style_Check then
Style.Check_HT;
end if;
Scan_Ptr := Scan_Ptr + 1;
Start_Column := (Start_Column / 8) * 8 + 8;
else
......
gcc/ada/sem_eval.adb
......@@ -1501,7 +1501,7 @@ package body Sem_Eval is
Set_Etype (N, Etype (Right));
end if;
Fold_Str (N, End_String, True);
Fold_Str (N, End_String, Static => True);
end if;
end;
end Eval_Concatenation;
......@@ -2732,7 +2732,7 @@ package body Sem_Eval is
-- Fold conversion, case of string type. The result is not static
if Is_String_Type (Target_Type) then
Fold_Str (N, Strval (Get_String_Val (Operand)), False);
Fold_Str (N, Strval (Get_String_Val (Operand)), Static => False);
return;
......@@ -4450,7 +4450,7 @@ package body Sem_Eval is
if Raises_Constraint_Error (Expr) then
Error_Msg_N
("expression raises exception, cannot be static " &
"('R'M 4.9(34))!", N);
"(RM 4.9(34))!", N);
return;
end if;
......@@ -4469,7 +4469,7 @@ package body Sem_Eval is
then
Error_Msg_N
("static expression must have scalar or string type " &
"('R'M 4.9(2))!", N);
"(RM 4.9(2))!", N);
return;
end if;
end if;
......@@ -4486,19 +4486,19 @@ package body Sem_Eval is
elsif Ekind (E) = E_Constant then
if not Is_Static_Expression (Constant_Value (E)) then
Error_Msg_NE
("& is not a static constant ('R'M 4.9(5))!", N, E);
("& is not a static constant (RM 4.9(5))!", N, E);
end if;
else
Error_Msg_NE
("& is not static constant or named number " &
"('R'M 4.9(5))!", N, E);
"(RM 4.9(5))!", N, E);
end if;
when N_Binary_Op | N_And_Then | N_Or_Else | N_Membership_Test =>
if Nkind (N) in N_Op_Shift then
Error_Msg_N
("shift functions are never static ('R'M 4.9(6,18))!", N);
("shift functions are never static (RM 4.9(6,18))!", N);
else
Why_Not_Static (Left_Opnd (N));
......@@ -4522,7 +4522,7 @@ package body Sem_Eval is
if Attribute_Name (N) = Name_Size then
Error_Msg_N
("size attribute is only static for scalar type " &
"('R'M 4.9(7,8))", N);
"(RM 4.9(7,8))", N);
-- Flag array cases
......@@ -4535,14 +4535,14 @@ package body Sem_Eval is
then
Error_Msg_N
("static array attribute must be Length, First, or Last " &
"('R'M 4.9(8))!", N);
"(RM 4.9(8))!", N);
-- Since we know the expression is not-static (we already
-- tested for this, must mean array is not static).
else
Error_Msg_N
("prefix is non-static array ('R'M 4.9(8))!", Prefix (N));
("prefix is non-static array (RM 4.9(8))!", Prefix (N));
end if;
return;
......@@ -4556,7 +4556,7 @@ package body Sem_Eval is
then
Error_Msg_N
("attribute of generic type is never static " &
"('R'M 4.9(7,8))!", N);
"(RM 4.9(7,8))!", N);
elsif Is_Static_Subtype (E) then
null;
......@@ -4564,43 +4564,43 @@ package body Sem_Eval is
elsif Is_Scalar_Type (E) then
Error_Msg_N
("prefix type for attribute is not static scalar subtype " &
"('R'M 4.9(7))!", N);
"(RM 4.9(7))!", N);
else
Error_Msg_N
("static attribute must apply to array/scalar type " &
"('R'M 4.9(7,8))!", N);
"(RM 4.9(7,8))!", N);
end if;
when N_String_Literal =>
Error_Msg_N
("subtype of string literal is non-static ('R'M 4.9(4))!", N);
("subtype of string literal is non-static (RM 4.9(4))!", N);
when N_Explicit_Dereference =>
Error_Msg_N
("explicit dereference is never static ('R'M 4.9)!", N);
("explicit dereference is never static (RM 4.9)!", N);
when N_Function_Call =>
Why_Not_Static_List (Parameter_Associations (N));
Error_Msg_N ("non-static function call ('R'M 4.9(6,18))!", N);
Error_Msg_N ("non-static function call (RM 4.9(6,18))!", N);
when N_Parameter_Association =>
Why_Not_Static (Explicit_Actual_Parameter (N));
when N_Indexed_Component =>
Error_Msg_N
("indexed component is never static ('R'M 4.9)!", N);
("indexed component is never static (RM 4.9)!", N);
when N_Procedure_Call_Statement =>
Error_Msg_N
("procedure call is never static ('R'M 4.9)!", N);
("procedure call is never static (RM 4.9)!", N);
when N_Qualified_Expression =>
Why_Not_Static (Expression (N));
when N_Aggregate | N_Extension_Aggregate =>
Error_Msg_N
("an aggregate is never static ('R'M 4.9)!", N);
("an aggregate is never static (RM 4.9)!", N);
when N_Range =>
Why_Not_Static (Low_Bound (N));
......@@ -4614,11 +4614,11 @@ package body Sem_Eval is
when N_Selected_Component =>
Error_Msg_N
("selected component is never static ('R'M 4.9)!", N);
("selected component is never static (RM 4.9)!", N);
when N_Slice =>
Error_Msg_N
("slice is never static ('R'M 4.9)!", N);
("slice is never static (RM 4.9)!", N);
when N_Type_Conversion =>
Why_Not_Static (Expression (N));
......@@ -4628,12 +4628,12 @@ package body Sem_Eval is
then
Error_Msg_N
("static conversion requires static scalar subtype result " &
"('R'M 4.9(9))!", N);
"(RM 4.9(9))!", N);
end if;
when N_Unchecked_Type_Conversion =>
Error_Msg_N
("unchecked type conversion is never static ('R'M 4.9)!", N);
("unchecked type conversion is never static (RM 4.9)!", N);
when others =>
null;
......
gcc/ada/sem_maps.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
......@@ -55,7 +55,7 @@ package body Sem_Maps is
---------------------
procedure Add_Association
(M : in out Map;
(M : Map;
O_Id : Entity_Id;
N_Id : Entity_Id;
Kind : Scope_Kind := S_Local)
......@@ -318,7 +318,7 @@ package body Sem_Maps is
------------------------
procedure Update_Association
(M : in out Map;
(M : Map;
O_Id : Entity_Id;
N_Id : Entity_Id;
Kind : Scope_Kind := S_Local)
......
gcc/ada/sem_maps.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
......@@ -64,14 +64,14 @@ package Sem_Maps is
-- Retrieve image of E under M, Empty if undefined
procedure Add_Association
(M : in out Map;
(M : Map;
O_Id : Entity_Id;
N_Id : Entity_Id;
Kind : Scope_Kind := S_Local);
-- Update M in place. On entry M (O_Id) must not be defined
procedure Update_Association
(M : in out Map;
(M : Map;
O_Id : Entity_Id;
N_Id : Entity_Id;
Kind : Scope_Kind := S_Local);
......
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