aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorRobert Dewar <dewar@adacore.com>2006-10-31 19:16:03 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2006-10-31 19:16:03 +0100
commitbfc8aa81e42ee0a2284061843b07e8035b91460a (patch)
tree3f325a73eb43505d6e56c239974922ae3bc57bb9 /gcc/ada
parente0ae4e94e9d2794ea89724bd7a7986728d019f15 (diff)
downloadgcc-bfc8aa81e42ee0a2284061843b07e8035b91460a.zip
gcc-bfc8aa81e42ee0a2284061843b07e8035b91460a.tar.gz
gcc-bfc8aa81e42ee0a2284061843b07e8035b91460a.tar.bz2
fmap.adb: Put routines in alpha order
2006-10-31 Robert Dewar <dewar@adacore.com> Thomas Quinot <quinot@adacore.com> Arnaud Charlet <charlet@adacore.com> * fmap.adb: Put routines in alpha order * g-boumai.ads: Remove redundant 'in' keywords * g-cgi.adb: Minor reformatting * g-cgi.ads: Remove redundant 'in' keywords * get_targ.adb: Put routines in alpha order * prj-attr.ads: Minor reformatting * s-atacco.ads: Minor reformatting * scn.adb: Put routines in alpha order * sinput-l.adb: Minor comment fix * sinput-p.adb: Minor comment fix * s-maccod.ads: Minor reformatting * s-memory.adb: Minor reformatting * s-htable.adb: Fix typo in comment. * s-secsta.adb: Minor comment update. * s-soflin.adb: Minor reformatting * s-stoele.ads: Add comment about odd qualification in Storage_Offset declaration * s-strxdr.adb: Remove unnecessary 'in' keywords for formal parameters. * treeprs.adt: Minor reformatting * urealp.adb: Put routines in alpha order * s-wchcon.ads, s-wchcon.adb (Get_WC_Encoding_Method): New version taking string. * s-asthan-vms-alpha.adb: Remove redundant 'in' keywords * g-trasym-vms-ia64.adb: Remove redundant 'in' keywords * env.c (__gnat_unsetenv): Unsetenv is unavailable on LynxOS, so workaround as on other platforms. * g-eacodu-vms.adb: Remove redundant 'in' keywords * g-expect-vms.adb: Remove redundant 'in' keywords * gnatdll.adb (Add_Files_From_List): Handle Name_Error and report a clear error message if the list-of-files file cannot be opened. * g-thread.adb (Unregister_Thread_Id): Add use type Thread_Id so the equality operator is always visible. * lang.opt: Woverlength-strings: New option. * nmake.adt: Update copyright, since nmake.ads and nmake.adb have changed. * osint-b.ads, osint-b.adb (Time_From_Last_Bind): removed function . (Binder_Output_Time_Stamps_Set): removed. (Old_Binder_Output_Time_Stamp): idem. (New_Binder_Output_Time_Stamp): idem. (Recording_Time_From_Last_Bind): idem. (Recording_Time_From_Last_Bind): Make constant. * output.ads, output.adb (Write_Str): Allow LF characters (Write_Spaces): New procedure * prepcomp.adb (Preproc_Data_Table): Change Increment from 5% to 100% * inline.adb: Minor reformatting * s-asthan-vms-alpha.adb: Remove redundant 'in' keywords * s-mastop-vms.adb: Remove redundant 'in' keywords * s-osprim-vms.adb: Remove redundant 'in' keywords * s-trafor-default.adb: Remove redundant 'in' keywords * 9drpc.adb: Remove redundant 'in' keywords * s-osinte-mingw.ads: Minor reformatting * s-inmaop-posix.adb: Minor reformatting * a-direio.ads: Remove quotes from Compile_Time_Warning message * a-exexda.adb: Minor code reorganization * a-filico.adb: Minor reformatting * a-finali.adb: Minor reformatting * a-nudira.ads: Remove quote from Compile_Time_Warning message * a-numeri.ads: Minor reformatting * a-sequio.ads: Remove quotes from Compile_Time_Warning message * exp_pakd.ads: Fix obsolete comment * a-ztenau.adb, a-ztenio.adb, a-wtenau.adb, a-tienau.adb, a-wtenio.adb (Put): Avoid assuming low bound of string is 1. Probably not a bug, but certainly neater and more efficient. * a-tienio.adb: Minor reformatting * comperr.adb (Compiler_Abort): Call Cancel_Special_Output at start Avoid assuming low bound of string is 1. * gnatbind.adb: Change Bindusg to package and rename procedure as Display, which now ensures that it only outputs usage information once. (Scan_Bind_Arg): Avoid assuming low bound of string is 1. * g-pehage.adb (Build_Identical_Keysets): Replace use of 1 by Table'First. * g-regpat.adb (Insert_Operator): Add pragma Warnings (Off) to kill warning. (Match): Add pragma Assert to ensure that Matches'First is zero * g-regpat.ads (Match): Document that Matches lower bound must be zero * makeutl.adb (Is_External_Assignment): Add pragma Assert's to check documented preconditions (also kills warnings about bad indexes). * mdll.adb (Build_Dynamic_Library): Avoid assumption that Afiles'First is 1. (Build_Import_Library): Ditto; * mdll-utl.adb: (Gnatbind): Avoid assumption that Alis'First = 1 * rtsfind.adb (RTE_Error_Msg): Avoid assuming low bound of string is 1. * sem_case.adb (Analyze_Choices): Add pragma Assert to check that lower bound of choice table is 1. * sem_case.ads (Analyze_Choices): Document that lower bound of Choice_Table is 1. * s-imgdec.adb (Set_Decimal_Digits): Avoid assuming low bound of string is 1. * uintp.adb (Init_Operand): Document that low bound of Vec is always 1, and add appropriate Assert pragma to suppress warnings. * atree.h, atree.ads, atree.adb Change Elist24 to Elist25 Add definitions of Field28 and Node28 (Traverse_Field): Use new syntactic parent table in sinfo. * cstand.adb: Change name Is_Ada_2005 to Is_Ada_2005_Only * itypes.adb: Change name Is_Ada_2005 to Is_Ada_2005_Only * exp_tss.adb: Put routines in alpha order * fe.h: Remove redundant declarations. From-SVN: r118330
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/9drpc.adb36
-rw-r--r--gcc/ada/a-direio.ads2
-rw-r--r--gcc/ada/a-exexda.adb11
-rw-r--r--gcc/ada/a-finali.adb7
-rw-r--r--gcc/ada/a-nudira.ads4
-rw-r--r--gcc/ada/a-numeri.ads4
-rw-r--r--gcc/ada/a-sequio.ads2
-rw-r--r--gcc/ada/a-tienau.adb4
-rw-r--r--gcc/ada/a-tienio.adb3
-rw-r--r--gcc/ada/a-wtenau.adb4
-rw-r--r--gcc/ada/a-ztenau.adb4
-rw-r--r--gcc/ada/a-ztenio.adb8
-rw-r--r--gcc/ada/atree.adb90
-rw-r--r--gcc/ada/atree.ads35
-rw-r--r--gcc/ada/atree.h6
-rw-r--r--gcc/ada/comperr.adb47
-rw-r--r--gcc/ada/cstand.adb20
-rw-r--r--gcc/ada/env.c2
-rw-r--r--gcc/ada/exp_pakd.ads8
-rw-r--r--gcc/ada/exp_tss.adb26
-rw-r--r--gcc/ada/fe.h4
-rw-r--r--gcc/ada/fmap.adb30
-rw-r--r--gcc/ada/g-boumai.ads4
-rw-r--r--gcc/ada/g-cgi.adb6
-rw-r--r--gcc/ada/g-cgi.ads4
-rw-r--r--gcc/ada/g-eacodu-vms.adb12
-rw-r--r--gcc/ada/g-expect-vms.adb6
-rw-r--r--gcc/ada/g-pehage.adb5
-rw-r--r--gcc/ada/g-regpat.adb25
-rw-r--r--gcc/ada/g-regpat.ads5
-rw-r--r--gcc/ada/g-thread.adb3
-rw-r--r--gcc/ada/g-trasym-vms-ia64.adb4
-rw-r--r--gcc/ada/get_targ.adb20
-rw-r--r--gcc/ada/gnatbind.adb14
-rw-r--r--gcc/ada/gnatdll.adb6
-rw-r--r--gcc/ada/inline.adb3
-rw-r--r--gcc/ada/itypes.adb16
-rw-r--r--gcc/ada/lang.opt4
-rw-r--r--gcc/ada/makeutl.adb5
-rw-r--r--gcc/ada/mdll-utl.adb4
-rw-r--r--gcc/ada/mdll.adb18
-rw-r--r--gcc/ada/nmake.adt2
-rw-r--r--gcc/ada/osint-b.adb90
-rw-r--r--gcc/ada/osint-b.ads20
-rw-r--r--gcc/ada/output.adb39
-rw-r--r--gcc/ada/output.ads14
-rw-r--r--gcc/ada/prj-attr.ads8
-rw-r--r--gcc/ada/s-asthan-vms-alpha.adb2
-rw-r--r--gcc/ada/s-atacco.ads2
-rw-r--r--gcc/ada/s-htable.adb8
-rw-r--r--gcc/ada/s-imgdec.adb17
-rw-r--r--gcc/ada/s-inmaop-posix.adb2
-rw-r--r--gcc/ada/s-maccod.ads7
-rw-r--r--gcc/ada/s-mastop-vms.adb8
-rw-r--r--gcc/ada/s-memory.adb4
-rw-r--r--gcc/ada/s-osinte-mingw.ads3
-rw-r--r--gcc/ada/s-osprim-vms.adb10
-rw-r--r--gcc/ada/s-secsta.adb4
-rw-r--r--gcc/ada/s-soflin.adb34
-rw-r--r--gcc/ada/s-stoele.ads6
-rw-r--r--gcc/ada/s-strxdr.adb40
-rw-r--r--gcc/ada/s-trafor-default.adb4
-rwxr-xr-xgcc/ada/s-wchcon.adb15
-rw-r--r--gcc/ada/s-wchcon.ads7
-rw-r--r--gcc/ada/scn.adb78
-rw-r--r--gcc/ada/sem_case.adb2
-rw-r--r--gcc/ada/sem_case.ads6
-rw-r--r--gcc/ada/sinput-l.adb4
-rw-r--r--gcc/ada/sinput-p.adb4
-rw-r--r--gcc/ada/treeprs.adt14
-rw-r--r--gcc/ada/uintp.adb15
-rw-r--r--gcc/ada/urealp.adb44
72 files changed, 523 insertions, 511 deletions
diff --git a/gcc/ada/9drpc.adb b/gcc/ada/9drpc.adb
index f8d36d3..75acad7 100644
--- a/gcc/ada/9drpc.adb
+++ b/gcc/ada/9drpc.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -93,11 +93,11 @@ package body System.RPC is
task type Anonymous_Task_Type (Self : Anonymous_Task_Node_Access) is
entry Start
- (Message_Id : in Message_Id_Type;
- Partition : in Partition_ID;
- Params_Size : in Ada.Streams.Stream_Element_Count;
- Result_Size : in Ada.Streams.Stream_Element_Count;
- Protocol : in Garlic.Protocol_Access);
+ (Message_Id : Message_Id_Type;
+ Partition : Partition_ID;
+ Params_Size : Ada.Streams.Stream_Element_Count;
+ Result_Size : Ada.Streams.Stream_Element_Count;
+ Protocol : Garlic.Protocol_Access);
-- This entry provides an anonymous task a remote call to perform.
-- This task calls for a Request id is provided to construct the
-- reply id by using -Request. Partition is used to send the reply
@@ -153,8 +153,8 @@ package body System.RPC is
-- When it is resumed, we provide the size of the reply
entry Wake_Up
- (Request : in Request_Id_Type;
- Length : in Ada.Streams.Stream_Element_Count);
+ (Request : Request_Id_Type;
+ Length : Ada.Streams.Stream_Element_Count);
-- To wake up the calling stub when the environnement task has
-- received a reply for this request
@@ -198,7 +198,7 @@ package body System.RPC is
-- Debugging package
procedure D
- (Flag : in Debug_Level; Info : in String) renames Debugging.Debug;
+ (Flag : Debug_Level; Info : String) renames Debugging.Debug;
-- Shortcut
------------------------
@@ -265,7 +265,7 @@ package body System.RPC is
-- Null_Node --
---------------
- function Null_Node (Index : in Packet_Node_Access) return Boolean is
+ function Null_Node (Index : Packet_Node_Access) return Boolean is
begin
return Index = null;
@@ -375,7 +375,7 @@ package body System.RPC is
procedure Write
(Stream : in out Params_Stream_Type;
- Item : in Ada.Streams.Stream_Element_Array)
+ Item : Ada.Streams.Stream_Element_Array)
renames System.RPC.Streams.Write;
-----------------------
@@ -687,8 +687,8 @@ package body System.RPC is
----------------------------
procedure Establish_RPC_Receiver
- (Partition : in Partition_ID;
- Receiver : in RPC_Receiver)
+ (Partition : Partition_ID;
+ Receiver : RPC_Receiver)
is
begin
-- Set Partition_RPC_Receiver and allow RPC mechanism
@@ -799,11 +799,11 @@ package body System.RPC is
select
accept Start
- (Message_Id : in Message_Id_Type;
- Partition : in Partition_ID;
- Params_Size : in Ada.Streams.Stream_Element_Count;
- Result_Size : in Ada.Streams.Stream_Element_Count;
- Protocol : in Protocol_Access)
+ (Message_Id : Message_Id_Type;
+ Partition : Partition_ID;
+ Params_Size : Ada.Streams.Stream_Element_Count;
+ Result_Size : Ada.Streams.Stream_Element_Count;
+ Protocol : Protocol_Access)
do
C_Message_Id := Message_Id;
C_Partition := Partition;
diff --git a/gcc/ada/a-direio.ads b/gcc/ada/a-direio.ads
index 29aef9c..24b2a0b 100644
--- a/gcc/ada/a-direio.ads
+++ b/gcc/ada/a-direio.ads
@@ -46,7 +46,7 @@ package Ada.Direct_IO is
pragma Compile_Time_Warning
(Element_Type'Has_Access_Values,
- "?Element_Type for Direct_'I'O instance has access values");
+ "Element_Type for Direct_IO instance has access values");
type File_Type is limited private;
diff --git a/gcc/ada/a-exexda.adb b/gcc/ada/a-exexda.adb
index 6b3b802..98d823d 100644
--- a/gcc/ada/a-exexda.adb
+++ b/gcc/ada/a-exexda.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -407,10 +407,13 @@ package body Exception_Data is
-----------------------------------------
function Basic_Exception_Tback_Maxlength
- (X : Exception_Occurrence) return Natural is
+ (X : Exception_Occurrence) return Natural
+ is
+ Space_Per_Traceback : constant := 2 + 16 + 1;
+ -- Space for "0x" + HHHHHHHHHHHHHHHH + " "
begin
- return BETB_Header'Length + 1 + X.Num_Tracebacks * 19 + 1;
- -- 19 = 2 + 16 + 1 for each address ("0x" + HHHH + " ")
+ return BETB_Header'Length + 1 +
+ X.Num_Tracebacks * Space_Per_Traceback + 1;
end Basic_Exception_Tback_Maxlength;
---------------------------------------
diff --git a/gcc/ada/a-finali.adb b/gcc/ada/a-finali.adb
index 9bc7290..92ba21d 100644
--- a/gcc/ada/a-finali.adb
+++ b/gcc/ada/a-finali.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -50,7 +50,6 @@ package body Ada.Finalization is
procedure Adjust (Object : in out Controlled) is
pragma Warnings (Off, Object);
-
begin
null;
end Adjust;
@@ -61,14 +60,12 @@ package body Ada.Finalization is
procedure Finalize (Object : in out Controlled) is
pragma Warnings (Off, Object);
-
begin
null;
end Finalize;
procedure Finalize (Object : in out Limited_Controlled) is
pragma Warnings (Off, Object);
-
begin
null;
end Finalize;
@@ -79,14 +76,12 @@ package body Ada.Finalization is
procedure Initialize (Object : in out Controlled) is
pragma Warnings (Off, Object);
-
begin
null;
end Initialize;
procedure Initialize (Object : in out Limited_Controlled) is
pragma Warnings (Off, Object);
-
begin
null;
end Initialize;
diff --git a/gcc/ada/a-nudira.ads b/gcc/ada/a-nudira.ads
index c6b2b3e..eb3baaa 100644
--- a/gcc/ada/a-nudira.ads
+++ b/gcc/ada/a-nudira.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 --
@@ -58,7 +58,7 @@ package Ada.Numerics.Discrete_Random is
pragma Compile_Time_Warning
(Result_Subtype'Size > 48,
- "statistical properties not guaranteed for size '> 48");
+ "statistical properties not guaranteed for size > 48");
-- Basic facilities
diff --git a/gcc/ada/a-numeri.ads b/gcc/ada/a-numeri.ads
index a0513d0..4d25bce 100644
--- a/gcc/ada/a-numeri.ads
+++ b/gcc/ada/a-numeri.ads
@@ -23,8 +23,8 @@ package Ada.Numerics is
["03C0"] : constant := Pi;
-- This is the greek letter Pi (for Ada 2005 AI-388). Note that it is
- -- conforming to have this present even in Ada 95 mode, because there is
- -- no way for a normal mode Ada 95 program to reference this identifier.
+ -- conforming to have this constant present even in Ada 95 mode, as there
+ -- is no way for a normal mode Ada 95 program to reference this identifier.
e : constant :=
2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996;
diff --git a/gcc/ada/a-sequio.ads b/gcc/ada/a-sequio.ads
index a811d56..3953f11 100644
--- a/gcc/ada/a-sequio.ads
+++ b/gcc/ada/a-sequio.ads
@@ -46,7 +46,7 @@ package Ada.Sequential_IO is
pragma Compile_Time_Warning
(Element_Type'Has_Access_Values,
- "?Element_Type for Sequential_'I'O instance has access values");
+ "Element_Type for Sequential_IO instance has access values");
type File_Type is limited private;
diff --git a/gcc/ada/a-tienau.adb b/gcc/ada/a-tienau.adb
index aadb479..a43c4cb 100644
--- a/gcc/ada/a-tienau.adb
+++ b/gcc/ada/a-tienau.adb
@@ -128,7 +128,7 @@ package body Ada.Text_IO.Enumeration_Aux is
Actual_Width : constant Count := Count'Max (Count (Width), Item'Length);
begin
- if Set = Lower_Case and then Item (1) /= ''' then
+ if Set = Lower_Case and then Item (Item'First) /= ''' then
declare
Iteml : String (Item'First .. Item'Last);
@@ -167,7 +167,7 @@ package body Ada.Text_IO.Enumeration_Aux is
else
Ptr := To'First;
for J in Item'Range loop
- if Set = Lower_Case and then Item (1) /= ''' then
+ if Set = Lower_Case and then Item (Item'First) /= ''' then
To (Ptr) := To_Lower (Item (J));
else
To (Ptr) := Item (J);
diff --git a/gcc/ada/a-tienio.adb b/gcc/ada/a-tienio.adb
index 6ff484d..0c07103 100644
--- a/gcc/ada/a-tienio.adb
+++ b/gcc/ada/a-tienio.adb
@@ -61,7 +61,6 @@ package body Ada.Text_IO.Enumeration_IO is
procedure Get (Item : out Enum) is
pragma Unsuppress (Range_Check);
-
begin
Get (Current_In, Item);
end Get;
@@ -98,7 +97,6 @@ package body Ada.Text_IO.Enumeration_IO is
Set : Type_Set := Default_Setting)
is
Image : constant String := Enum'Image (Item);
-
begin
Aux.Put (File, Image, Width, Set);
end Put;
@@ -118,7 +116,6 @@ package body Ada.Text_IO.Enumeration_IO is
Set : Type_Set := Default_Setting)
is
Image : constant String := Enum'Image (Item);
-
begin
Aux.Puts (To, Image, Set);
end Put;
diff --git a/gcc/ada/a-wtenau.adb b/gcc/ada/a-wtenau.adb
index 0bba4ec..fcb4e1e 100644
--- a/gcc/ada/a-wtenau.adb
+++ b/gcc/ada/a-wtenau.adb
@@ -159,7 +159,7 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
begin
Check_On_One_Line (TFT (File), Actual_Width);
- if Set = Lower_Case and then Item (1) /= ''' then
+ if Set = Lower_Case and then Item (Item'First) /= ''' then
declare
Iteml : Wide_String (Item'First .. Item'Last);
@@ -204,7 +204,7 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
Ptr := To'First;
for J in Item'Range loop
if Set = Lower_Case
- and then Item (1) /= '''
+ and then Item (Item'First) /= '''
and then Is_Character (Item (J))
then
To (Ptr) :=
diff --git a/gcc/ada/a-ztenau.adb b/gcc/ada/a-ztenau.adb
index 01d996c..b7d2375 100644
--- a/gcc/ada/a-ztenau.adb
+++ b/gcc/ada/a-ztenau.adb
@@ -160,7 +160,7 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_Aux is
begin
Check_On_One_Line (TFT (File), Actual_Width);
- if Set = Lower_Case and then Item (1) /= ''' then
+ if Set = Lower_Case and then Item (Item'First) /= ''' then
declare
Iteml : Wide_Wide_String (Item'First .. Item'Last);
@@ -206,7 +206,7 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_Aux is
Ptr := To'First;
for J in Item'Range loop
if Set = Lower_Case
- and then Item (1) /= '''
+ and then Item (Item'First) /= '''
and then Is_Character (Item (J))
then
To (Ptr) :=
diff --git a/gcc/ada/a-ztenio.adb b/gcc/ada/a-ztenio.adb
index 4b95295..9591447 100644
--- a/gcc/ada/a-ztenio.adb
+++ b/gcc/ada/a-ztenio.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -44,11 +44,9 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
procedure Get (File : File_Type; Item : out Enum) is
Buf : Wide_Wide_String (1 .. Enum'Width);
Buflen : Natural;
-
begin
Aux.Get_Enum_Lit (File, Buf, Buflen);
Item := Enum'Wide_Wide_Value (Buf (1 .. Buflen));
-
exception
when Constraint_Error => raise Data_Error;
end Get;
@@ -64,11 +62,9 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
Last : out Positive)
is
Start : Natural;
-
begin
Aux.Scan_Enum_Lit (From, Start, Last);
Item := Enum'Wide_Wide_Value (From (Start .. Last));
-
exception
when Constraint_Error => raise Data_Error;
end Get;
@@ -84,7 +80,6 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
Set : Type_Set := Default_Setting)
is
Image : constant Wide_Wide_String := Enum'Wide_Wide_Image (Item);
-
begin
Aux.Put (File, Image, Width, Set);
end Put;
@@ -104,7 +99,6 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_IO is
Set : Type_Set := Default_Setting)
is
Image : constant Wide_Wide_String := Enum'Wide_Wide_Image (Item);
-
begin
Aux.Puts (To, Image, Set);
end Put;
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 119cf62..1cdf5ae 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -2360,17 +2360,24 @@ package body Atree is
function Traverse_Func (Node : Node_Id) return Traverse_Result is
- function Traverse_Field (Fld : Union_Id) return Traverse_Result;
- -- Fld is one of the fields of Node. If the field points to a
- -- syntactic node or list, then this node or list is traversed,
- -- and the result is the result of this traversal. Otherwise
- -- a value of True is returned with no processing.
+ function Traverse_Field
+ (Nod : Node_Id;
+ Fld : Union_Id;
+ FN : Field_Num) return Traverse_Result;
+ -- Fld is one of the fields of Nod. If the field points to syntactic
+ -- node or list, then this node or list is traversed, and the result is
+ -- the result of this traversal. Otherwise a value of True is returned
+ -- with no processing. FN is the number of the field (1 .. 5).
--------------------
-- Traverse_Field --
--------------------
- function Traverse_Field (Fld : Union_Id) return Traverse_Result is
+ function Traverse_Field
+ (Nod : Node_Id;
+ Fld : Union_Id;
+ FN : Field_Num) return Traverse_Result
+ is
begin
if Fld = Union_Id (Empty) then
return OK;
@@ -2381,9 +2388,7 @@ package body Atree is
-- Traverse descendent that is syntactic subtree node
- if Parent (Node_Id (Fld)) = Node
- or else Original_Node (Parent (Node_Id (Fld))) = Node
- then
+ if Is_Syntactic_Field (Nkind (Nod), FN) then
return Traverse_Func (Node_Id (Fld));
-- Node that is not a syntactic subtree
@@ -2398,9 +2403,7 @@ package body Atree is
-- Traverse descendent that is a syntactic subtree list
- if Parent (List_Id (Fld)) = Node
- or else Original_Node (Parent (List_Id (Fld))) = Node
- then
+ if Is_Syntactic_Field (Nkind (Nod), FN) then
declare
Elmt : Node_Id := First (List_Id (Fld));
begin
@@ -2439,39 +2442,36 @@ package body Atree is
return OK;
when OK =>
- if Traverse_Field (Union_Id (Field1 (Node))) = Abandon
+ if Traverse_Field (Node, Union_Id (Field1 (Node)), 1) = Abandon
or else
- Traverse_Field (Union_Id (Field2 (Node))) = Abandon
+ Traverse_Field (Node, Union_Id (Field2 (Node)), 2) = Abandon
or else
- Traverse_Field (Union_Id (Field3 (Node))) = Abandon
+ Traverse_Field (Node, Union_Id (Field3 (Node)), 3) = Abandon
or else
- Traverse_Field (Union_Id (Field4 (Node))) = Abandon
+ Traverse_Field (Node, Union_Id (Field4 (Node)), 4) = Abandon
or else
- Traverse_Field (Union_Id (Field5 (Node))) = Abandon
+ Traverse_Field (Node, Union_Id (Field5 (Node)), 5) = Abandon
then
return Abandon;
-
else
return OK;
end if;
when OK_Orig =>
declare
- Onode : constant Node_Id := Original_Node (Node);
-
+ Onod : constant Node_Id := Original_Node (Node);
begin
- if Traverse_Field (Union_Id (Field1 (Onode))) = Abandon
+ if Traverse_Field (Onod, Union_Id (Field1 (Onod)), 1) = Abandon
or else
- Traverse_Field (Union_Id (Field2 (Onode))) = Abandon
+ Traverse_Field (Onod, Union_Id (Field2 (Onod)), 2) = Abandon
or else
- Traverse_Field (Union_Id (Field3 (Onode))) = Abandon
+ Traverse_Field (Onod, Union_Id (Field3 (Onod)), 3) = Abandon
or else
- Traverse_Field (Union_Id (Field4 (Onode))) = Abandon
+ Traverse_Field (Onod, Union_Id (Field4 (Onod)), 4) = Abandon
or else
- Traverse_Field (Union_Id (Field5 (Onode))) = Abandon
+ Traverse_Field (Onod, Union_Id (Field5 (Onod)), 5) = Abandon
then
return Abandon;
-
else
return OK_Orig;
end if;
@@ -2681,6 +2681,12 @@ package body Atree is
return Nodes.Table (N + 4).Field9;
end Field27;
+ function Field28 (N : Node_Id) return Union_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Nodes.Table (N + 4).Field10;
+ end Field28;
+
function Node1 (N : Node_Id) return Node_Id is
begin
pragma Assert (N in Nodes.First .. Nodes.Last);
@@ -2843,6 +2849,12 @@ package body Atree is
return Node_Id (Nodes.Table (N + 4).Field9);
end Node27;
+ function Node28 (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ return Node_Id (Nodes.Table (N + 4).Field10);
+ end Node28;
+
function List1 (N : Node_Id) return List_Id is
begin
pragma Assert (N in Nodes.First .. Nodes.Last);
@@ -2995,16 +3007,16 @@ package body Atree is
end if;
end Elist23;
- function Elist24 (N : Node_Id) return Elist_Id is
+ function Elist25 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
- Value : constant Union_Id := Nodes.Table (N + 4).Field6;
+ Value : constant Union_Id := Nodes.Table (N + 4).Field7;
begin
if Value = 0 then
return No_Elist;
else
return Elist_Id (Value);
end if;
- end Elist24;
+ end Elist25;
function Name1 (N : Node_Id) return Name_Id is
begin
@@ -4647,6 +4659,12 @@ package body Atree is
Nodes.Table (N + 4).Field9 := Val;
end Set_Field27;
+ procedure Set_Field28 (N : Node_Id; Val : Union_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field10 := Val;
+ end Set_Field28;
+
procedure Set_Node1 (N : Node_Id; Val : Node_Id) is
begin
pragma Assert (N in Nodes.First .. Nodes.Last);
@@ -4809,6 +4827,12 @@ package body Atree is
Nodes.Table (N + 4).Field9 := Union_Id (Val);
end Set_Node27;
+ procedure Set_Node28 (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 4).Field10 := Union_Id (Val);
+ end Set_Node28;
+
procedure Set_List1 (N : Node_Id; Val : List_Id) is
begin
pragma Assert (N in Nodes.First .. Nodes.Last);
@@ -4908,11 +4932,11 @@ package body Atree is
Nodes.Table (N + 3).Field10 := Union_Id (Val);
end Set_Elist23;
- procedure Set_Elist24 (N : Node_Id; Val : Elist_Id) is
+ procedure Set_Elist25 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 4).Field6 := Union_Id (Val);
- end Set_Elist24;
+ Nodes.Table (N + 4).Field7 := Union_Id (Val);
+ end Set_Elist25;
procedure Set_Name1 (N : Node_Id; Val : Name_Id) is
begin
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 94618d9..80d531d 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -49,7 +49,7 @@ package Atree is
-- this tree. There is no separate symbol table structure.
-- WARNING: There is a C version of this package. Any changes to this
--- source file must be properly reflected in the C header file tree.h
+-- source file must be properly reflected in the C header file atree.h
-- Package Atree defines the basic structure of the tree and its nodes and
-- provides the basic abstract interface for manipulating the tree. Two
@@ -198,8 +198,8 @@ package Atree is
-- Elist6 Synonym for Field6 typed as Elist_Id (Empty = No_Elist)
-- Uint6 Synonym for Field6 typed as Uint (Empty = Uint_0)
- -- Similar definitions for Field7 to Field27 (and Node7-Node27,
- -- Elist7-Elist27, Uint7-Uint27, Ureal7-Ureal27). Note that not all
+ -- Similar definitions for Field7 to Field28 (and Node7-Node28,
+ -- Elist7-Elist28, Uint7-Uint28, Ureal7-Ureal28). Note that not all
-- these functions are defined, only the ones that are actually used.
type Paren_Count_Type is mod 4;
@@ -434,9 +434,9 @@ package Atree is
function New_Copy_Tree
(Source : Node_Id;
- Map : Elist_Id := No_Elist;
+ Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
- New_Scope : Entity_Id := Empty) return Node_Id;
+ New_Scope : Entity_Id := Empty) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Tree copies the entire
-- syntactic subtree, including recursively any descendents whose parent
-- field references a copied node (descendents not linked to a copied node
@@ -860,6 +860,9 @@ package Atree is
function Field27 (N : Node_Id) return Union_Id;
pragma Inline (Field27);
+ function Field28 (N : Node_Id) return Union_Id;
+ pragma Inline (Field28);
+
function Node1 (N : Node_Id) return Node_Id;
pragma Inline (Node1);
@@ -941,6 +944,9 @@ package Atree is
function Node27 (N : Node_Id) return Node_Id;
pragma Inline (Node27);
+ function Node28 (N : Node_Id) return Node_Id;
+ pragma Inline (Node28);
+
function List1 (N : Node_Id) return List_Id;
pragma Inline (List1);
@@ -992,8 +998,8 @@ package Atree is
function Elist23 (N : Node_Id) return Elist_Id;
pragma Inline (Elist23);
- function Elist24 (N : Node_Id) return Elist_Id;
- pragma Inline (Elist24);
+ function Elist25 (N : Node_Id) return Elist_Id;
+ pragma Inline (Elist25);
function Name1 (N : Node_Id) return Name_Id;
pragma Inline (Name1);
@@ -1785,6 +1791,9 @@ package Atree is
procedure Set_Field27 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field27);
+ procedure Set_Field28 (N : Node_Id; Val : Union_Id);
+ pragma Inline (Set_Field28);
+
procedure Set_Node1 (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Node1);
@@ -1866,6 +1875,9 @@ package Atree is
procedure Set_Node27 (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Node27);
+ procedure Set_Node28 (N : Node_Id; Val : Node_Id);
+ pragma Inline (Set_Node28);
+
procedure Set_List1 (N : Node_Id; Val : List_Id);
pragma Inline (Set_List1);
@@ -1917,8 +1929,8 @@ package Atree is
procedure Set_Elist23 (N : Node_Id; Val : Elist_Id);
pragma Inline (Set_Elist23);
- procedure Set_Elist24 (N : Node_Id; Val : Elist_Id);
- pragma Inline (Set_Elist24);
+ procedure Set_Elist25 (N : Node_Id; Val : Elist_Id);
+ pragma Inline (Set_Elist25);
procedure Set_Name1 (N : Node_Id; Val : Name_Id);
pragma Inline (Set_Name1);
@@ -2832,8 +2844,7 @@ package Atree is
-- above is used to hold additional general fields and flags
-- as follows:
- -- Field6-9 Holds Field24-Field27
- -- Field10 currently unused, reserved for expansion
+ -- Field6-10 Holds Field24-Field28
-- Field11 Holds Flag184-Flag215
-- Field12 currently unused, reserved for expansion
diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h
index 77d430c..bc96b20 100644
--- a/gcc/ada/atree.h
+++ b/gcc/ada/atree.h
@@ -6,7 +6,7 @@
* *
* C Header File *
* *
- * Copyright (C) 1992-2005, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -382,6 +382,7 @@ extern Node_Id Current_Error_Node;
#define Field25(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field7)
#define Field26(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field8)
#define Field27(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field9)
+#define Field28(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field10)
#define Node1(N) Field1 (N)
#define Node2(N) Field2 (N)
@@ -410,6 +411,7 @@ extern Node_Id Current_Error_Node;
#define Node25(N) Field25 (N)
#define Node26(N) Field26 (N)
#define Node27(N) Field27 (N)
+#define Node28(N) Field28 (N)
#define List1(N) Field1 (N)
#define List2(N) Field2 (N)
@@ -429,7 +431,7 @@ extern Node_Id Current_Error_Node;
#define Elist18(N) Field18 (N)
#define Elist21(N) Field21 (N)
#define Elist23(N) Field23 (N)
-#define Elist24(N) Field24 (N)
+#define Elist25(N) Field25 (N)
#define Name1(N) Field1 (N)
#define Name2(N) Field2 (N)
diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb
index 59d0bd2..648c4b1 100644
--- a/gcc/ada/comperr.adb
+++ b/gcc/ada/comperr.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -80,6 +80,9 @@ package body Comperr is
-- the FSF version of GNAT, but there are specializations for
-- the GNATPRO and Public releases by AdaCore.
+ XF : constant Positive := X'First;
+ -- Start index, usually 1, but we won't assume this
+
procedure End_Line;
-- Add blanks up to column 76, and then a final vertical bar
@@ -93,12 +96,14 @@ package body Comperr is
Write_Eol;
end End_Line;
- Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
- Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
+ Is_GPL_Version : constant Boolean := Get_Gnat_Build_Type = GPL;
+ Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
-- Start of processing for Compiler_Abort
begin
+ Cancel_Special_Output;
+
-- Prevent recursion through Compiler_Abort, e.g. via SIGSEGV
if Abort_In_Progress then
@@ -173,16 +178,16 @@ package body Comperr is
Last_Blank : Integer := 70;
begin
- for P in 40 .. 69 loop
- if X (P) = ' ' then
+ for P in 39 .. 68 loop
+ if X (XF + P) = ' ' then
Last_Blank := P;
end if;
end loop;
- Write_Str (X (1 .. Last_Blank));
+ Write_Str (X (XF .. XF - 1 + Last_Blank));
End_Line;
Write_Str ("| ");
- Write_Str (X (Last_Blank + 1 .. X'Length));
+ Write_Str (X (XF + Last_Blank .. X'Last));
end;
else
Write_Str (X);
@@ -267,13 +272,23 @@ package body Comperr is
" http://gcc.gnu.org/bugs.html.");
End_Line;
- elsif Is_Public_Version then
+ elsif Is_GPL_Version then
+
Write_Str
- ("| submit bug report by email " &
+ ("| Please submit a bug report by email " &
"to report@adacore.com.");
End_Line;
Write_Str
+ ("| GAP members can alternatively use GNAT Tracker:");
+ End_Line;
+
+ Write_Str
+ ("| http://www.adacore.com/ " &
+ "section 'send a report'.");
+ End_Line;
+
+ Write_Str
("| See gnatinfo.txt for full info on procedure " &
"for submitting bugs.");
End_Line;
@@ -290,7 +305,12 @@ package body Comperr is
Write_Str
("| alternatively submit a bug report by email " &
- "to report@adacore.com.");
+ "to report@adacore.com,");
+ End_Line;
+
+ Write_Str
+ ("| including your customer number #nnn " &
+ "in the subject line.");
End_Line;
end if;
@@ -299,13 +319,6 @@ package body Comperr is
" and us to track the bug.");
End_Line;
- if not (Is_Public_Version or Is_FSF_Version) then
- Write_Str
- ("| Include your customer number #nnn " &
- "in the subject line.");
- End_Line;
- end if;
-
Write_Str
("| Include the entire contents of this bug " &
"box in the report.");
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index cbe5969..5f4b203 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -628,7 +628,7 @@ package body CStand is
Set_Is_Character_Type (Standard_Wide_Wide_Character);
Set_Is_Known_Valid (Standard_Wide_Wide_Character);
Set_Size_Known_At_Compile_Time (Standard_Wide_Wide_Character);
- Set_Is_Ada_2005 (Standard_Wide_Wide_Character);
+ Set_Is_Ada_2005_Only (Standard_Wide_Wide_Character);
-- Create the bounds for type Wide_Wide_Character
@@ -743,14 +743,14 @@ package body CStand is
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
- Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
- Set_Etype (Standard_Wide_Wide_String,
- Standard_Wide_Wide_String);
- Set_Component_Type (Standard_Wide_Wide_String,
- Standard_Wide_Wide_Character);
- Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
- Init_Size_Align (Standard_Wide_Wide_String);
- Set_Is_Ada_2005 (Standard_Wide_Wide_String);
+ Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
+ Set_Etype (Standard_Wide_Wide_String,
+ Standard_Wide_Wide_String);
+ Set_Component_Type (Standard_Wide_Wide_String,
+ Standard_Wide_Wide_Character);
+ Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
+ Init_Size_Align (Standard_Wide_Wide_String);
+ Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
-- Set index type of Wide_Wide_String
diff --git a/gcc/ada/env.c b/gcc/ada/env.c
index 9465a3e..cbcd132 100644
--- a/gcc/ada/env.c
+++ b/gcc/ada/env.c
@@ -218,7 +218,7 @@ void __gnat_unsetenv (char *name) {
#elif defined (__hpux__) || defined (sun) \
|| (defined (__mips) && defined (__sgi)) \
|| (defined (__vxworks) && ! defined (__RTP__)) \
- || defined (_AIX)
+ || defined (_AIX) || defined (__Lynx__)
/* On Solaris, HP-UX and IRIX there is no function to clear an environment
variable. So we look for the variable in the environ table and delete it
diff --git a/gcc/ada/exp_pakd.ads b/gcc/ada/exp_pakd.ads
index bd00459..a124ca6 100644
--- a/gcc/ada/exp_pakd.ads
+++ b/gcc/ada/exp_pakd.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -201,10 +201,8 @@ package Exp_Pakd is
-- 1-2-...-7-8 9-10-...15-16 17-18-19-20-x-x-x-x x-x-x-x-x-x-x-x
- -- and now, we do indeed have the same representation. The special flag
- -- Is_Left_Justified_Modular is set in the modular type used as the
- -- packed array type in the big-endian case to ensure that this required
- -- left justification occurs.
+ -- and now, we do indeed have the same representation for the memory
+ -- version in the constrained and unconstrained cases.
-----------------
-- Subprograms --
diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb
index 78f975d..ad60e7a 100644
--- a/gcc/ada/exp_tss.adb
+++ b/gcc/ada/exp_tss.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -238,37 +238,37 @@ package body Exp_Tss is
return Make_TSS_Name (Typ, TSS_Init_Proc);
end Make_Init_Proc_Name;
- -------------------------
- -- Make_TSS_Name_Local --
- -------------------------
+ -------------------
+ -- Make_TSS_Name --
+ -------------------
- function Make_TSS_Name_Local
+ function Make_TSS_Name
(Typ : Entity_Id;
Nam : TSS_Name_Type) return Name_Id
is
begin
Get_Name_String (Chars (Typ));
- Add_Char_To_Name_Buffer ('_');
- Add_Nat_To_Name_Buffer (Increment_Serial_Number);
Add_Char_To_Name_Buffer (Nam (1));
Add_Char_To_Name_Buffer (Nam (2));
return Name_Find;
- end Make_TSS_Name_Local;
+ end Make_TSS_Name;
- -------------------
- -- Make_TSS_Name --
- -------------------
+ -------------------------
+ -- Make_TSS_Name_Local --
+ -------------------------
- function Make_TSS_Name
+ function Make_TSS_Name_Local
(Typ : Entity_Id;
Nam : TSS_Name_Type) return Name_Id
is
begin
Get_Name_String (Chars (Typ));
+ Add_Char_To_Name_Buffer ('_');
+ Add_Nat_To_Name_Buffer (Increment_Serial_Number);
Add_Char_To_Name_Buffer (Nam (1));
Add_Char_To_Name_Buffer (Nam (2));
return Name_Find;
- end Make_TSS_Name;
+ end Make_TSS_Name_Local;
--------------
-- Same_TSS --
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 4706d4c..6e2dde3 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -6,7 +6,7 @@
* *
* C Header File *
* *
- * Copyright (C) 1992-2005, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -167,12 +167,10 @@ extern Boolean Back_Annotate_Rep_Info;
#define No_Exception_Handlers_Set restrict__no_exception_handlers_set
#define Check_No_Implicit_Heap_Alloc restrict__check_no_implicit_heap_alloc
#define Check_Elaboration_Code_Allowed restrict__check_elaboration_code_allowed
-#define Check_No_Implicit_Heap_Alloc restrict__check_no_implicit_heap_alloc
extern Boolean No_Exception_Handlers_Set (void);
extern void Check_No_Implicit_Heap_Alloc (Node_Id);
extern void Check_Elaboration_Code_Allowed (Node_Id);
-extern void Check_No_Implicit_Heap_Alloc (Node_Id);
/* sem_elim: */
diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb
index cb2e352..37e1002 100644
--- a/gcc/ada/fmap.adb
+++ b/gcc/ada/fmap.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -200,6 +200,20 @@ package body Fmap is
Last_In_Table := 0;
end Empty_Tables;
+ ---------------
+ -- Find_Name --
+ ---------------
+
+ function Find_Name return Name_Id is
+ begin
+ if Name_Buffer (1 .. Name_Len) = "/" then
+ return Error_Name;
+
+ else
+ return Name_Find;
+ end if;
+ end Find_Name;
+
--------------
-- Get_Line --
--------------
@@ -236,20 +250,6 @@ package body Fmap is
end if;
end Get_Line;
- ---------------
- -- Find_Name --
- ---------------
-
- function Find_Name return Name_Id is
- begin
- if Name_Buffer (1 .. Name_Len) = "/" then
- return Error_Name;
-
- else
- return Name_Find;
- end if;
- end Find_Name;
-
----------------------
-- Report_Truncated --
----------------------
diff --git a/gcc/ada/g-boumai.ads b/gcc/ada/g-boumai.ads
index c3a0db5..bcadf34 100644
--- a/gcc/ada/g-boumai.ads
+++ b/gcc/ada/g-boumai.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2003-2005, AdaCore --
+-- Copyright (C) 2003-2006, 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- --
@@ -71,7 +71,7 @@ package GNAT.Bounded_Mailboxes is
-- Protected type Mailbox has the following inherited interface:
- -- entry Insert (Item : in Message_Reference);
+ -- entry Insert (Item : Message_Reference);
-- Insert Item into the Mailbox. Blocks caller
-- until space is available.
diff --git a/gcc/ada/g-cgi.adb b/gcc/ada/g-cgi.adb
index 03bbeb4..34f3e4f 100644
--- a/gcc/ada/g-cgi.adb
+++ b/gcc/ada/g-cgi.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, AdaCore --
+-- Copyright (C) 2001-2006, 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- --
@@ -188,6 +188,7 @@ package body GNAT.CGI is
Data : constant String := Metavariable (Query_String);
begin
Current_Method := Get;
+
if Data /= "" then
Set_Parameter_Table (Data);
end if;
@@ -335,9 +336,8 @@ package body GNAT.CGI is
---------------------
function Get_Environment (Variable_Name : String) return String is
- Value : OS_Lib.String_Access := OS_Lib.Getenv (Variable_Name);
+ Value : OS_Lib.String_Access := OS_Lib.Getenv (Variable_Name);
Result : constant String := Value.all;
-
begin
OS_Lib.Free (Value);
return Result;
diff --git a/gcc/ada/g-cgi.ads b/gcc/ada/g-cgi.ads
index 6ad3d5f..eb7d70c 100644
--- a/gcc/ada/g-cgi.ads
+++ b/gcc/ada/g-cgi.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, AdaCore --
+-- Copyright (C) 2000-2006, 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- --
@@ -68,7 +68,7 @@
-- procedure New_Client is
-- use GNAT;
--- procedure Add_Client_To_Database (Name : in String) is
+-- procedure Add_Client_To_Database (Name : String) is
-- begin
-- ...
-- end Add_Client_To_Database;
diff --git a/gcc/ada/g-eacodu-vms.adb b/gcc/ada/g-eacodu-vms.adb
index d2a8f39..9c0bceb 100644
--- a/gcc/ada/g-eacodu-vms.adb
+++ b/gcc/ada/g-eacodu-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -54,17 +54,17 @@ procedure Core_Dump (Occurrence : Exception_Occurrence) is
procedure Setexv (
Status : out Cond_Value_Type;
- Vector : in Unsigned_Longword := 0;
- Addres : in Address := Address_Zero;
- Acmode : in Access_Mode_Type := Access_Mode_Zero;
- Prvhnd : in Unsigned_Longword := 0);
+ Vector : Unsigned_Longword := 0;
+ Addres : Address := Address_Zero;
+ Acmode : Access_Mode_Type := Access_Mode_Zero;
+ Prvhnd : Unsigned_Longword := 0);
pragma Interface (External, Setexv);
pragma Import_Valued_Procedure (Setexv, "SYS$SETEXV",
(Cond_Value_Type, Unsigned_Longword, Address, Access_Mode_Type,
Unsigned_Longword),
(Value, Value, Value, Value, Value));
- procedure Lib_Signal (I : in Integer);
+ procedure Lib_Signal (I : Integer);
pragma Interface (C, Lib_Signal);
pragma Import_Procedure (Lib_Signal, "LIB$SIGNAL", Mechanism => (Value));
begin
diff --git a/gcc/ada/g-expect-vms.adb b/gcc/ada/g-expect-vms.adb
index b37449f..2381c66 100644
--- a/gcc/ada/g-expect-vms.adb
+++ b/gcc/ada/g-expect-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2005, AdaCore --
+-- Copyright (C) 2002-2006, 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- --
@@ -1058,8 +1058,8 @@ package body GNAT.Expect is
Pipe1 : in out Pipe_Type;
Pipe2 : in out Pipe_Type;
Pipe3 : in out Pipe_Type;
- Cmd : in String;
- Args : in System.Address)
+ Cmd : String;
+ Args : System.Address)
is
pragma Warnings (Off, Pid);
diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb
index cf8b62a..ef0ac85 100644
--- a/gcc/ada/g-pehage.adb
+++ b/gcc/ada/g-pehage.adb
@@ -1970,6 +1970,7 @@ package body GNAT.Perfect_Hash_Generators is
-- position selection plus Pos. Once this routine is called, reduced
-- words are sorted by subsets and each item (First, Last) in Sets
-- defines the range of identical keys.
+ -- Need comment saying exactly what Last is ???
function Count_Different_Keys
(Table : Vertex_Table_Type;
@@ -1991,9 +1992,9 @@ package body GNAT.Perfect_Hash_Generators is
Last : in out Natural;
Pos : Natural)
is
- S : constant Vertex_Table_Type := Table (1 .. Last);
+ S : constant Vertex_Table_Type := Table (Table'First .. Last);
C : constant Natural := Pos;
- -- Shortcuts
+ -- Shortcuts (why are these not renames ???)
F : Integer;
L : Integer;
diff --git a/gcc/ada/g-regpat.adb b/gcc/ada/g-regpat.adb
index 6bfc2d9..de76a7b 100644
--- a/gcc/ada/g-regpat.adb
+++ b/gcc/ada/g-regpat.adb
@@ -684,9 +684,12 @@ package body GNAT.Regpat is
Operand : Pointer;
Greedy : Boolean := True)
is
- Dest : constant Pointer := Emit_Ptr;
- Old : Pointer;
- Size : Pointer := 3;
+ Dest : constant Pointer := Emit_Ptr;
+ Old : Pointer;
+ Size : Pointer := 3;
+
+ Discard : Pointer;
+ pragma Warnings (Off, Discard);
begin
-- If not greedy, we have to emit another opcode first
@@ -713,7 +716,7 @@ package body GNAT.Regpat is
Link_Tail (Old, Old + 3);
end if;
- Old := Emit_Node (Op);
+ Discard := Emit_Node (Op);
Emit_Ptr := Dest + Size;
end Insert_Operator;
@@ -2364,21 +2367,23 @@ package body GNAT.Regpat is
-----------
procedure Match
- (Self : Pattern_Matcher;
- Data : String;
- Matches : out Match_Array;
+ (Self : Pattern_Matcher;
+ Data : String;
+ Matches : out Match_Array;
Data_First : Integer := -1;
Data_Last : Positive := Positive'Last)
is
- Program : Program_Data renames Self.Program; -- Shorter notation
+ pragma Assert (Matches'First = 0);
+
+ Program : Program_Data renames Self.Program; -- Shorter notation
First_In_Data : constant Integer := Integer'Max (Data_First, Data'First);
Last_In_Data : constant Integer := Integer'Min (Data_Last, Data'Last);
-- Global work variables
- Input_Pos : Natural; -- String-input pointer
- BOL_Pos : Natural; -- Beginning of input, for ^ check
+ Input_Pos : Natural; -- String-input pointer
+ BOL_Pos : Natural; -- Beginning of input, for ^ check
Matched : Boolean := False; -- Until proven True
Matches_Full : Match_Array (0 .. Natural'Max (Self.Paren_Count,
diff --git a/gcc/ada/g-regpat.ads b/gcc/ada/g-regpat.ads
index 42dc3f4..dbe65b4 100644
--- a/gcc/ada/g-regpat.ads
+++ b/gcc/ada/g-regpat.ads
@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1986 by University of Toronto. --
--- Copyright (C) 1996-2005, AdaCore --
+-- Copyright (C) 1996-2006, 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- --
@@ -583,7 +583,8 @@ package GNAT.Regpat is
Data_First : Integer := -1;
Data_Last : Positive := Positive'Last);
-- Match Data using the given pattern matcher and store result in Matches.
- -- The expression matches if Matches (0) /= No_Match.
+ -- The expression matches if Matches (0) /= No_Match. The lower bound of
+ -- Matches is required to be zero.
--
-- At most Matches'Length parenthesis are returned
diff --git a/gcc/ada/g-thread.adb b/gcc/ada/g-thread.adb
index b49ed23..6f9dfe7 100644
--- a/gcc/ada/g-thread.adb
+++ b/gcc/ada/g-thread.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005 AdaCore --
+-- Copyright (C) 1998-2006 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- --
@@ -128,6 +128,7 @@ package body GNAT.Threads is
T : Tasking.Task_Id;
use type Tasking.Task_Id;
+ use type System.OS_Interface.Thread_Id;
begin
STPO.Lock_RTS;
diff --git a/gcc/ada/g-trasym-vms-ia64.adb b/gcc/ada/g-trasym-vms-ia64.adb
index 1d82b66..7636a64 100644
--- a/gcc/ada/g-trasym-vms-ia64.adb
+++ b/gcc/ada/g-trasym-vms-ia64.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -69,7 +69,7 @@ package body GNAT.Traceback.Symbolic is
procedure Symbolize
(Status : out Cond_Value_Type;
- Current_PC : in Address;
+ Current_PC : Address;
Filename_Name : out Address;
Library_Name : out Address;
Record_Number : out Integer;
diff --git a/gcc/ada/get_targ.adb b/gcc/ada/get_targ.adb
index e737175..fb2b226 100644
--- a/gcc/ada/get_targ.adb
+++ b/gcc/ada/get_targ.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -42,6 +42,15 @@ package body Get_Targ is
end if;
end Digits_From_Size;
+ -----------------------------
+ -- Get_Max_Unaligned_Field --
+ -----------------------------
+
+ function Get_Max_Unaligned_Field return Pos is
+ begin
+ return 64; -- Can be different on some targets (e.g., AAMP)
+ end Get_Max_Unaligned_Field;
+
---------------------
-- Width_From_Size --
---------------------
@@ -57,13 +66,4 @@ package body Get_Targ is
end if;
end Width_From_Size;
- -----------------------------
- -- Get_Max_Unaligned_Field --
- -----------------------------
-
- function Get_Max_Unaligned_Field return Pos is
- begin
- return 64; -- Can be different on some targets (e.g., AAMP)
- end Get_Max_Unaligned_Field;
-
end Get_Targ;
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb
index e1dddd9..9895362 100644
--- a/gcc/ada/gnatbind.adb
+++ b/gcc/ada/gnatbind.adb
@@ -85,7 +85,7 @@ procedure Gnatbind is
procedure Scan_Bind_Arg (Argv : String);
-- Scan and process binder specific arguments. Argv is a single argument.
-- All the one character arguments are still handled by Switch. This
- -- routine handles -aO -aI and -I-.
+ -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
function Is_Cross_Compiler return Boolean;
-- Returns True iff this is a cross-compiler
@@ -206,6 +206,8 @@ procedure Gnatbind is
-------------------
procedure Scan_Bind_Arg (Argv : String) is
+ pragma Assert (Argv'First = 1);
+
begin
-- Now scan arguments that are specific to the binder and are not
-- handled by the common circuitry in Switch.
@@ -420,11 +422,11 @@ begin
Scan_Args : while Next_Arg < Arg_Count loop
declare
Next_Argv : String (1 .. Len_Arg (Next_Arg));
-
begin
Fill_Arg (Next_Argv'Address, Next_Arg);
Scan_Bind_Arg (Next_Argv);
end;
+
Next_Arg := Next_Arg + 1;
end loop Scan_Args;
@@ -449,7 +451,7 @@ begin
-- Output usage if requested
if Usage_Requested then
- Bindusg;
+ Bindusg.Display;
end if;
-- Check that the Ada binder file specified has extension .adb and that
@@ -535,7 +537,7 @@ begin
-- Output usage information if no files
if not More_Lib_Files then
- Bindusg;
+ Bindusg.Display;
Exit_Program (E_Fatal);
end if;
@@ -600,8 +602,8 @@ begin
-- Set standard configuration parameters
- Suppress_Standard_Library_On_Target := True;
- Configurable_Run_Time_Mode := True;
+ Suppress_Standard_Library_On_Target := True;
+ Configurable_Run_Time_Mode := True;
end if;
-- For main ALI files, even if they are interfaces, we get their
diff --git a/gcc/ada/gnatdll.adb b/gcc/ada/gnatdll.adb
index fdcf6b4..ada455e 100644
--- a/gcc/ada/gnatdll.adb
+++ b/gcc/ada/gnatdll.adb
@@ -253,6 +253,12 @@ procedure Gnatdll is
end loop;
Close (File);
+
+ exception
+ when Name_Error =>
+ Raise_Exception
+ (Syntax_Error'Identity,
+ "list-of-files file " & List_Filename & " not found.");
end Add_Files_From_List;
-- Start of processing for Parse_Command_Line
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 7847a15..3575d8f 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -579,7 +579,6 @@ package body Inline is
end loop;
Comp_Unit := Parent (Pack);
-
while Present (Comp_Unit)
and then Nkind (Comp_Unit) /= N_Compilation_Unit
loop
diff --git a/gcc/ada/itypes.adb b/gcc/ada/itypes.adb
index 4b65da2..14216f6 100644
--- a/gcc/ada/itypes.adb
+++ b/gcc/ada/itypes.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -93,14 +93,14 @@ package body Itypes is
Set_Etype (I_Typ, T);
Init_Size_Align (I_Typ);
Set_Depends_On_Private (I_Typ, Depends_On_Private (T));
- Set_Is_Public (I_Typ, Is_Public (T));
- Set_From_With_Type (I_Typ, From_With_Type (T));
+ Set_Is_Public (I_Typ, Is_Public (T));
+ Set_From_With_Type (I_Typ, From_With_Type (T));
Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T));
- Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
- Set_Is_Volatile (I_Typ, Is_Volatile (T));
- Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
- Set_Is_Atomic (I_Typ, Is_Atomic (T));
- Set_Is_Ada_2005 (I_Typ, Is_Ada_2005 (T));
+ Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
+ Set_Is_Volatile (I_Typ, Is_Volatile (T));
+ Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
+ Set_Is_Atomic (I_Typ, Is_Atomic (T));
+ Set_Is_Ada_2005_Only (I_Typ, Is_Ada_2005_Only (T));
Set_Can_Never_Be_Null (I_Typ);
return I_Typ;
diff --git a/gcc/ada/lang.opt b/gcc/ada/lang.opt
index 305ff13..82636b4 100644
--- a/gcc/ada/lang.opt
+++ b/gcc/ada/lang.opt
@@ -61,6 +61,10 @@ Wmissing-format-attribute
Ada
; Documented for C
+Woverlength-strings
+Ada
+; Documented for C
+
nostdinc
Ada RejectNegative
; Don't look for source files
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 8a7039f..4a7a0b9 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -135,6 +135,9 @@ package body Makeutl is
Finish : Natural := Argv'Last;
Equal_Pos : Natural;
+ pragma Assert (Argv'First = 1);
+ pragma Assert (Argv (1 .. 2) = "-X");
+
begin
if Argv'Last < 5 then
return False;
diff --git a/gcc/ada/mdll-utl.adb b/gcc/ada/mdll-utl.adb
index 991f3fd..7939199 100644
--- a/gcc/ada/mdll-utl.adb
+++ b/gcc/ada/mdll-utl.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -250,7 +250,7 @@ package body MDLL.Utl is
if not Success then
declare
Base_Name : constant String :=
- Directory_Operations.Base_Name (Alis (1).all, ".ali");
+ Directory_Operations.Base_Name (Alis (Alis'First).all, ".ali");
begin
OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
diff --git a/gcc/ada/mdll.adb b/gcc/ada/mdll.adb
index 2e7ae46..a3188b3 100644
--- a/gcc/ada/mdll.adb
+++ b/gcc/ada/mdll.adb
@@ -394,6 +394,8 @@ package body MDLL is
raise;
end Ada_Build_Non_Reloc_DLL;
+ -- Start of processing for Build_Dynamic_Library
+
begin
-- On Windows the binder file must not be in the first position in the
-- list. This is due to the way DLL's are built on Windows. We swap the
@@ -402,13 +404,14 @@ package body MDLL is
if L_Afiles'Length > 1 then
declare
Filename : constant String :=
- Directory_Operations.Base_Name (L_Afiles (1).all);
+ Directory_Operations.Base_Name
+ (L_Afiles (L_Afiles'First).all);
First : constant Positive := Filename'First;
begin
if Filename (First .. First + 1) = "b~" then
- L_Afiles (L_Afiles'Last) := Afiles (1);
- L_Afiles (1) := Afiles (Afiles'Last);
+ L_Afiles (L_Afiles'Last) := Afiles (Afiles'First);
+ L_Afiles (L_Afiles'First) := Afiles (Afiles'Last);
end if;
end;
end if;
@@ -438,7 +441,6 @@ package body MDLL is
(Lib_Filename : String;
Def_Filename : String)
is
-
procedure Build_Import_Library (Lib_Filename : String);
-- Build an import library. This is to build only a .a library to link
-- against a DLL.
@@ -472,8 +474,12 @@ package body MDLL is
-- convention and we try as much as possible to follow the platform
-- convention.
- if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
- Build_Import_Library (Lib_Filename (4 .. Lib_Filename'Last));
+ if Lib_Filename'Length > 3
+ and then
+ Lib_Filename (Lib_Filename'First .. Lib_Filename'First + 2) = "lib"
+ then
+ Build_Import_Library
+ (Lib_Filename (Lib_Filename'First + 3 .. Lib_Filename'Last));
else
Build_Import_Library (Lib_Filename);
end if;
diff --git a/gcc/ada/nmake.adt b/gcc/ada/nmake.adt
index 3567bb7..240d522 100644
--- a/gcc/ada/nmake.adt
+++ b/gcc/ada/nmake.adt
@@ -6,7 +6,7 @@
-- --
-- T e m p l a t e --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
diff --git a/gcc/ada/osint-b.adb b/gcc/ada/osint-b.adb
index 2dc070e..d7c8e35 100644
--- a/gcc/ada/osint-b.adb
+++ b/gcc/ada/osint-b.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -30,12 +30,6 @@ with Targparm; use Targparm;
package body Osint.B is
- Binder_Output_Time_Stamps_Set : Boolean := False;
-
- Old_Binder_Output_Time_Stamp : Time_Stamp_Type;
- New_Binder_Output_Time_Stamp : Time_Stamp_Type;
- Recording_Time_From_Last_Bind : Boolean := False;
-
-------------------------
-- Close_Binder_Output --
-------------------------
@@ -51,10 +45,6 @@ package body Osint.B is
Get_Name_String (Output_File_Name));
end if;
- if Recording_Time_From_Last_Bind then
- New_Binder_Output_Time_Stamp := File_Stamp (Output_File_Name);
- Binder_Output_Time_Stamps_Set := True;
- end if;
end Close_Binder_Output;
--------------------------
@@ -164,10 +154,6 @@ package body Osint.B is
Bfile := Name_Find;
- if Recording_Time_From_Last_Bind then
- Old_Binder_Output_Time_Stamp := File_Stamp (Bfile);
- end if;
-
Create_File_And_Check (Output_FD, Text);
end Create_Binder_Output;
@@ -183,80 +169,6 @@ package body Osint.B is
function Next_Main_Lib_File return File_Name_Type renames Next_Main_File;
- --------------------------------
- -- Record_Time_From_Last_Bind --
- --------------------------------
-
- procedure Record_Time_From_Last_Bind is
- begin
- Recording_Time_From_Last_Bind := True;
- end Record_Time_From_Last_Bind;
-
- -------------------------
- -- Time_From_Last_Bind --
- -------------------------
-
- function Time_From_Last_Bind return Nat is
- Old_Y : Nat;
- Old_M : Nat;
- Old_D : Nat;
- Old_H : Nat;
- Old_Mi : Nat;
- Old_S : Nat;
- New_Y : Nat;
- New_M : Nat;
- New_D : Nat;
- New_H : Nat;
- New_Mi : Nat;
- New_S : Nat;
-
- type Month_Data is array (Int range 1 .. 12) of Int;
- Cumul : constant Month_Data := (0, 0, 3, 3, 4, 4, 5, 5, 5, 6, 6, 7);
- -- Represents the difference in days from a period compared to the
- -- same period if all months had 31 days, i.e:
- --
- -- Cumul (m) = 31x(m-1) - (number of days from 01/01 to m/01)
-
- Res : Int;
-
- begin
- if not Recording_Time_From_Last_Bind
- or else not Binder_Output_Time_Stamps_Set
- or else Old_Binder_Output_Time_Stamp = Empty_Time_Stamp
- then
- return Nat'Last;
- end if;
-
- Split_Time_Stamp
- (Old_Binder_Output_Time_Stamp,
- Old_Y, Old_M, Old_D, Old_H, Old_Mi, Old_S);
-
- Split_Time_Stamp
- (New_Binder_Output_Time_Stamp,
- New_Y, New_M, New_D, New_H, New_Mi, New_S);
-
- Res := New_Mi - Old_Mi;
-
- -- 60 minutes in an hour
-
- Res := Res + 60 * (New_H - Old_H);
-
- -- 24 hours in a day
-
- Res := Res + 60 * 24 * (New_D - Old_D);
-
- -- Almost 31 days in a month
-
- Res := Res + 60 * 24 *
- (31 * (New_M - Old_M) - Cumul (New_M) + Cumul (Old_M));
-
- -- 365 days in a year
-
- Res := Res + 60 * 24 * 365 * (New_Y - Old_Y);
-
- return Res;
- end Time_From_Last_Bind;
-
-----------------------
-- Write_Binder_Info --
-----------------------
diff --git a/gcc/ada/osint-b.ads b/gcc/ada/osint-b.ads
index e919c29..6ba2bb9 100644
--- a/gcc/ada/osint-b.ads
+++ b/gcc/ada/osint-b.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -29,10 +29,6 @@
package Osint.B is
- procedure Record_Time_From_Last_Bind;
- -- Trigger the computing of the time from the last bind of the same
- -- program.
-
function More_Lib_Files return Boolean;
-- Indicates whether more library information files remain to be processed.
-- Returns False right away if no source files, or if all source files
@@ -45,20 +41,6 @@ package Osint.B is
-- called only if a previous call to More_Lib_Files returned True). This
-- name is the simple name, excluding any directory information.
- function Time_From_Last_Bind return Nat;
- -- This function give an approximate number of minute from the last bind.
- -- It bases its computation on file stamp and therefore does gibe not
- -- any meaningful result before the new output binder file is written.
- -- So it returns Nat'last if:
- --
- -- - it is the first bind of this specific program
- -- - Record_Time_From_Last_Bind was not Called first
- -- - Close_Binder_Output was not called first
- --
- -- otherwise it returns the number of minutes from the last bind. The
- -- computation does not try to be completely accurate and in particular
- -- does not take leap years into account.
-
-------------------
-- Binder Output --
-------------------
diff --git a/gcc/ada/output.adb b/gcc/ada/output.adb
index e7e7ea0..c9695fa 100644
--- a/gcc/ada/output.adb
+++ b/gcc/ada/output.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -58,6 +58,15 @@ package body Output is
Special_Output_Proc := null;
end Cancel_Special_Output;
+ ------------
+ -- Column --
+ ------------
+
+ function Column return Pos is
+ begin
+ return Pos (Next_Col);
+ end Column;
+
------------------
-- Flush_Buffer --
------------------
@@ -100,15 +109,6 @@ package body Output is
end if;
end Flush_Buffer;
- ------------
- -- Column --
- ------------
-
- function Column return Pos is
- begin
- return Pos (Next_Col);
- end Column;
-
---------------------------
-- Restore_Output_Buffer --
---------------------------
@@ -240,8 +240,12 @@ package body Output is
Write_Eol;
end if;
- Buffer (Next_Col) := C;
- Next_Col := Next_Col + 1;
+ if C = ASCII.LF then
+ Write_Eol;
+ else
+ Buffer (Next_Col) := C;
+ Next_Col := Next_Col + 1;
+ end if;
end Write_Char;
---------------
@@ -295,6 +299,17 @@ package body Output is
Write_Eol;
end Write_Line;
+ ------------------
+ -- Write_Spaces --
+ ------------------
+
+ procedure Write_Spaces (N : Nat) is
+ begin
+ for J in 1 .. N loop
+ Write_Char (' ');
+ end loop;
+ end Write_Spaces;
+
---------------
-- Write_Str --
---------------
diff --git a/gcc/ada/output.ads b/gcc/ada/output.ads
index 10df655..7273ce5 100644
--- a/gcc/ada/output.ads
+++ b/gcc/ada/output.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -101,11 +101,15 @@ package Output is
-- Write an integer value with no leading blanks or zeroes. Negative
-- values are preceded by a minus sign).
+ procedure Write_Spaces (N : Nat);
+ -- Write N spaces
+
procedure Write_Str (S : String);
-- Write a string of characters to the standard output file. Note that
- -- end of line is handled separately using WRITE_EOL, so the string
- -- should not contain either of the characters LF or CR, but it may
- -- contain horizontal tab characters.
+ -- end of line is normally handled separately using WRITE_EOL, but it
+ -- is allowed for the string to contain LF (but not CR) characters,
+ -- which are properly interpreted as end of line characters. The string
+ -- may also contain horizontal tab characters.
procedure Write_Line (S : String);
-- Equivalent to Write_Str (S) followed by Write_Eol;
@@ -144,7 +148,7 @@ package Output is
-- names, precisely to make sure that they are only used for debugging!
procedure w (C : Character);
- -- Dump quote, character quote, followed by line return
+ -- Dump quote, character, quote, followed by line return
procedure w (S : String);
-- Dump string followed by line return
diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads
index df96404..732feb3 100644
--- a/gcc/ada/prj-attr.ads
+++ b/gcc/ada/prj-attr.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -110,7 +110,7 @@ package Prj.Attr is
-- The type to refers to an attribute, self-initialized
Empty_Attribute : constant Attribute_Node_Id;
- -- Indicates no attribute. Default value of Attribute_Node_Id objects.
+ -- Indicates no attribute. Default value of Attribute_Node_Id objects
Attribute_First : constant Attribute_Node_Id;
-- First attribute node id of project level attributes
@@ -205,7 +205,7 @@ private
----------------
Attributes_Initial : constant := 50;
- Attributes_Increment : constant := 50;
+ Attributes_Increment : constant := 100;
Attribute_Node_Low_Bound : constant := 0;
Attribute_Node_High_Bound : constant := 099_999_999;
@@ -235,7 +235,7 @@ private
--------------
Packages_Initial : constant := 10;
- Packages_Increment : constant := 50;
+ Packages_Increment : constant := 100;
Package_Node_Low_Bound : constant := 0;
Package_Node_High_Bound : constant := 099_999_999;
diff --git a/gcc/ada/s-asthan-vms-alpha.adb b/gcc/ada/s-asthan-vms-alpha.adb
index f108058..867aafd 100644
--- a/gcc/ada/s-asthan-vms-alpha.adb
+++ b/gcc/ada/s-asthan-vms-alpha.adb
@@ -517,7 +517,7 @@ package body System.AST_Handling is
----------------------------
procedure Expand_AST_Packet_Pool
- (Requested_Packets : in Natural;
+ (Requested_Packets : Natural;
Actual_Number : out Natural;
Total_Number : out Natural)
is
diff --git a/gcc/ada/s-atacco.ads b/gcc/ada/s-atacco.ads
index 6e2b434..9fd2839 100644
--- a/gcc/ada/s-atacco.ads
+++ b/gcc/ada/s-atacco.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 --
diff --git a/gcc/ada/s-htable.adb b/gcc/ada/s-htable.adb
index d8d419d..cc890d6 100644
--- a/gcc/ada/s-htable.adb
+++ b/gcc/ada/s-htable.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2005 AdaCore --
+-- Copyright (C) 1995-2006, 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- --
@@ -48,9 +48,9 @@ package body System.HTable is
Iterator_Started : Boolean := False;
function Get_Non_Null return Elmt_Ptr;
- -- Returns Null_Ptr if Iterator_Started is false of the Table is
- -- empty. Returns Iterator_Ptr if non null, or the next non null
- -- element in table if any.
+ -- Returns Null_Ptr if Iterator_Started is false or the Table is empty.
+ -- Returns Iterator_Ptr if non null, or the next non null element in
+ -- table if any.
---------
-- Get --
diff --git a/gcc/ada/s-imgdec.adb b/gcc/ada/s-imgdec.adb
index 34bd68b..d57d07d 100644
--- a/gcc/ada/s-imgdec.adb
+++ b/gcc/ada/s-imgdec.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -41,8 +41,7 @@ package body System.Img_Dec is
function Image_Decimal
(V : Integer;
- Scale : Integer)
- return String
+ Scale : Integer) return String
is
P : Natural := 0;
S : String (1 .. 64);
@@ -76,10 +75,10 @@ package body System.Img_Dec is
Aft : Natural;
Exp : Natural)
is
- Minus : constant Boolean := (Digs (1) = '-');
+ Minus : constant Boolean := (Digs (Digs'First) = '-');
-- Set True if input is negative
- Zero : Boolean := (Digs (2) = '0');
+ Zero : Boolean := (Digs (Digs'First + 1) = '0');
-- Set True if input is exactly zero (only case when a leading zero
-- is permitted in the input string given to this procedure). This
-- flag can get set later if rounding causes the value to become zero.
@@ -147,10 +146,10 @@ package body System.Img_Dec is
-- The result is zero, unless we are rounding just before
-- the first digit, and the first digit is five or more.
- if N = 1 and then Digs (2) >= '5' then
- Digs (1) := '1';
+ if N = 1 and then Digs (Digs'First + 1) >= '5' then
+ Digs (Digs'First) := '1';
else
- Digs (1) := '0';
+ Digs (Digs'First) := '0';
Zero := True;
end if;
@@ -181,7 +180,7 @@ package body System.Img_Dec is
-- OK, because we already captured the value of the sign and
-- we are in any case destroying the value in the Digs buffer
- Digs (1) := '1';
+ Digs (Digs'First) := '1';
FD := 1;
ND := ND + 1;
Digits_Before_Point := Digits_Before_Point + 1;
diff --git a/gcc/ada/s-inmaop-posix.adb b/gcc/ada/s-inmaop-posix.adb
index 486795c..e9da380 100644
--- a/gcc/ada/s-inmaop-posix.adb
+++ b/gcc/ada/s-inmaop-posix.adb
@@ -295,7 +295,7 @@ begin
end loop;
- -- Setup the masks to be exported.
+ -- Setup the masks to be exported
Result := sigemptyset (mask'Access);
pragma Assert (Result = 0);
diff --git a/gcc/ada/s-maccod.ads b/gcc/ada/s-maccod.ads
index 490e9d69..d0082ae6 100644
--- a/gcc/ada/s-maccod.ads
+++ b/gcc/ada/s-maccod.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -89,8 +89,7 @@ package System.Machine_Code is
Outputs : Asm_Output_Operand_List;
Inputs : Asm_Input_Operand_List;
Clobber : String := "";
- Volatile : Boolean := False)
- return Asm_Insn;
+ Volatile : Boolean := False) return Asm_Insn;
function Asm (
Template : String;
@@ -121,7 +120,7 @@ private
type Asm_Output_Operand is new Integer;
type Asm_Insn is new Integer;
-- All three of these types are dummy types, to meet the requirements of
- -- type consistenty. No values of these types are ever referenced.
+ -- type consistency. No values of these types are ever referenced.
No_Input_Operands : constant Asm_Input_Operand := 0;
No_Output_Operands : constant Asm_Output_Operand := 0;
diff --git a/gcc/ada/s-mastop-vms.adb b/gcc/ada/s-mastop-vms.adb
index ce462cb..4b239f2 100644
--- a/gcc/ada/s-mastop-vms.adb
+++ b/gcc/ada/s-mastop-vms.adb
@@ -7,7 +7,7 @@
-- B o d y --
-- (Version for Alpha/VMS) --
-- --
--- Copyright (C) 2001-2005, AdaCore --
+-- Copyright (C) 2001-2006, 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- --
@@ -175,7 +175,7 @@ package body System.Machine_State_Operations is
function Get_Code_Loc (M : Machine_State) return Code_Loc is
procedure Get_Invo_Context (
Result : out Unsigned_Longword; -- return value
- Invo_Handle : in Invo_Handle_Type;
+ Invo_Handle : Invo_Handle_Type;
Invo_Context : out Invo_Context_Blk_Type);
pragma Interface (External, Get_Invo_Context);
@@ -221,7 +221,7 @@ package body System.Machine_State_Operations is
procedure Pop_Frame (M : Machine_State) is
procedure Get_Prev_Invo_Handle (
Result : out Invo_Handle_Type; -- return value
- ICB : in Invo_Handle_Type);
+ ICB : Invo_Handle_Type);
pragma Interface (External, Get_Prev_Invo_Handle);
@@ -255,7 +255,7 @@ package body System.Machine_State_Operations is
procedure Get_Invo_Handle (
Result : out Invo_Handle_Type; -- return value
- Invo_Context : in Invo_Context_Blk_Type);
+ Invo_Context : Invo_Context_Blk_Type);
pragma Interface (External, Get_Invo_Handle);
diff --git a/gcc/ada/s-memory.adb b/gcc/ada/s-memory.adb
index a529954..d149bd5 100644
--- a/gcc/ada/s-memory.adb
+++ b/gcc/ada/s-memory.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
--- This is the default implementation of this package.
+-- This is the default implementation of this package
-- This implementation assumes that the underlying malloc/free/realloc
-- implementation is thread safe, and thus, no additional lock is required.
diff --git a/gcc/ada/s-osinte-mingw.ads b/gcc/ada/s-osinte-mingw.ads
index 8cc916a..1989c14 100644
--- a/gcc/ada/s-osinte-mingw.ads
+++ b/gcc/ada/s-osinte-mingw.ads
@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2006, 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- --
@@ -68,6 +68,7 @@ package System.OS_Interface is
subtype PSZ is Interfaces.C.Strings.chars_ptr;
subtype PCHAR is Interfaces.C.Strings.chars_ptr;
+
subtype PVOID is System.Address;
Null_Void : constant PVOID := System.Null_Address;
diff --git a/gcc/ada/s-osprim-vms.adb b/gcc/ada/s-osprim-vms.adb
index 7d7a7dc..54b4b90 100644
--- a/gcc/ada/s-osprim-vms.adb
+++ b/gcc/ada/s-osprim-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006 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- --
@@ -77,10 +77,10 @@ package body System.OS_Primitives is
procedure Sys_Schdwk
(
Status : out Cond_Value_Type;
- Pidadr : in Address := Null_Address;
- Prcnam : in String := String'Null_Parameter;
- Daytim : in Long_Integer;
- Reptim : in Long_Integer := Long_Integer'Null_Parameter
+ Pidadr : Address := Null_Address;
+ Prcnam : String := String'Null_Parameter;
+ Daytim : Long_Integer;
+ Reptim : Long_Integer := Long_Integer'Null_Parameter
);
pragma Interface (External, Sys_Schdwk);
diff --git a/gcc/ada/s-secsta.adb b/gcc/ada/s-secsta.adb
index 3c6485c..bc43eed 100644
--- a/gcc/ada/s-secsta.adb
+++ b/gcc/ada/s-secsta.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -487,7 +487,7 @@ package body System.Secondary_Stack is
-- Allocate a secondary stack for the main program to use
-- We make sure that the stack has maximum alignment. Some systems require
- -- this (e.g. Sun), and in any case it is a good idea for efficiency.
+ -- this (e.g. Sparc), and in any case it is a good idea for efficiency.
Stack : aliased Stack_Id;
for Stack'Alignment use Standard'Maximum_Alignment;
diff --git a/gcc/ada/s-soflin.adb b/gcc/ada/s-soflin.adb
index 8c32568..0e5c582 100644
--- a/gcc/ada/s-soflin.adb
+++ b/gcc/ada/s-soflin.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -54,7 +54,7 @@ package body System.Soft_Links is
-- This is currently only used under VMS.
NT_TSD : TSD;
- -- Note: we rely on the default initialization of NT_TSD.
+ -- Note: we rely on the default initialization of NT_TSD
--------------------
-- Abort_Defer_NT --
@@ -295,14 +295,14 @@ package body System.Soft_Links is
null;
end Task_Lock_NT;
- --------------------
- -- Task_Unlock_NT --
- --------------------
+ ------------------
+ -- Task_Name_NT --
+ -------------------
- procedure Task_Unlock_NT is
+ function Task_Name_NT return String is
begin
- null;
- end Task_Unlock_NT;
+ return "main_task";
+ end Task_Name_NT;
-------------------------
-- Task_Termination_NT --
@@ -314,6 +314,15 @@ package body System.Soft_Links is
null;
end Task_Termination_NT;
+ --------------------
+ -- Task_Unlock_NT --
+ --------------------
+
+ procedure Task_Unlock_NT is
+ begin
+ null;
+ end Task_Unlock_NT;
+
-------------------------
-- Update_Exception_NT --
-------------------------
@@ -323,13 +332,4 @@ package body System.Soft_Links is
Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X);
end Update_Exception_NT;
- ------------------
- -- Task_Name_NT --
- -------------------
-
- function Task_Name_NT return String is
- begin
- return "main_task";
- end Task_Name_NT;
-
end System.Soft_Links;
diff --git a/gcc/ada/s-stoele.ads b/gcc/ada/s-stoele.ads
index ca50e03..3b1527b 100644
--- a/gcc/ada/s-stoele.ads
+++ b/gcc/ada/s-stoele.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2006, 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 --
@@ -54,6 +54,10 @@ package System.Storage_Elements is
type Storage_Offset is range
-(2 ** (Integer'(Standard'Address_Size) - 1)) ..
+(2 ** (Integer'(Standard'Address_Size) - 1)) - Long_Long_Integer'(1);
+ -- Note: the reason for the Long_Long_Integer qualification here is to
+ -- avoid a bogus ambiguity when this unit is analyzed in an rtsfind
+ -- context. It may be possible to remove this in the future, but it is
+ -- certainly harmless in any case ???
subtype Storage_Count is Storage_Offset range 0 .. Storage_Offset'Last;
diff --git a/gcc/ada/s-strxdr.adb b/gcc/ada/s-strxdr.adb
index 63aa286..053582c 100644
--- a/gcc/ada/s-strxdr.adb
+++ b/gcc/ada/s-strxdr.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, Free Software Foundation, Inc. --
-- --
-- GARLIC 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- --
@@ -1041,7 +1041,7 @@ package body System.Stream_Attributes is
-- W_AD --
----------
- procedure W_AD (Stream : not null access RST; Item : in Fat_Pointer) is
+ procedure W_AD (Stream : not null access RST; Item : Fat_Pointer) is
S : XDR_S_TM;
U : XDR_TM;
@@ -1071,7 +1071,7 @@ package body System.Stream_Attributes is
-- W_AS --
----------
- procedure W_AS (Stream : not null access RST; Item : in Thin_Pointer) is
+ procedure W_AS (Stream : not null access RST; Item : Thin_Pointer) is
S : XDR_S_TM;
U : XDR_TM := XDR_TM (To_XDR_SA (Item.P1));
@@ -1092,7 +1092,7 @@ package body System.Stream_Attributes is
-- W_B --
---------
- procedure W_B (Stream : not null access RST; Item : in Boolean) is
+ procedure W_B (Stream : not null access RST; Item : Boolean) is
begin
if Item then
W_SSU (Stream, 1);
@@ -1105,7 +1105,7 @@ package body System.Stream_Attributes is
-- W_C --
---------
- procedure W_C (Stream : not null access RST; Item : in Character) is
+ procedure W_C (Stream : not null access RST; Item : Character) is
S : XDR_S_C;
pragma Assert (C_L = 1);
@@ -1123,7 +1123,7 @@ package body System.Stream_Attributes is
-- W_F --
---------
- procedure W_F (Stream : not null access RST; Item : in Float) is
+ procedure W_F (Stream : not null access RST; Item : Float) is
I : constant Precision := Single;
E_Size : Integer renames Fields (I).E_Size;
E_Bias : Integer renames Fields (I).E_Bias;
@@ -1205,7 +1205,7 @@ package body System.Stream_Attributes is
-- W_I --
---------
- procedure W_I (Stream : not null access RST; Item : in Integer) is
+ procedure W_I (Stream : not null access RST; Item : Integer) is
S : XDR_S_I;
U : XDR_U;
@@ -1239,7 +1239,7 @@ package body System.Stream_Attributes is
-- W_LF --
----------
- procedure W_LF (Stream : not null access RST; Item : in Long_Float) is
+ procedure W_LF (Stream : not null access RST; Item : Long_Float) is
I : constant Precision := Double;
E_Size : Integer renames Fields (I).E_Size;
E_Bias : Integer renames Fields (I).E_Bias;
@@ -1321,7 +1321,7 @@ package body System.Stream_Attributes is
-- W_LI --
----------
- procedure W_LI (Stream : not null access RST; Item : in Long_Integer) is
+ procedure W_LI (Stream : not null access RST; Item : Long_Integer) is
S : XDR_S_LI;
U : Unsigned;
X : Long_Unsigned;
@@ -1367,7 +1367,7 @@ package body System.Stream_Attributes is
-- W_LLF --
-----------
- procedure W_LLF (Stream : not null access RST; Item : in Long_Long_Float) is
+ procedure W_LLF (Stream : not null access RST; Item : Long_Long_Float) is
I : constant Precision := Quadruple;
E_Size : Integer renames Fields (I).E_Size;
E_Bias : Integer renames Fields (I).E_Bias;
@@ -1463,7 +1463,7 @@ package body System.Stream_Attributes is
-----------
procedure W_LLI (Stream : not null access RST;
- Item : in Long_Long_Integer)
+ Item : Long_Long_Integer)
is
S : XDR_S_LLI;
U : Unsigned;
@@ -1511,7 +1511,7 @@ package body System.Stream_Attributes is
-----------
procedure W_LLU (Stream : not null access RST;
- Item : in Long_Long_Unsigned) is
+ Item : Long_Long_Unsigned) is
S : XDR_S_LLU;
U : Unsigned;
X : Long_Long_Unsigned := Item;
@@ -1548,7 +1548,7 @@ package body System.Stream_Attributes is
-- W_LU --
----------
- procedure W_LU (Stream : not null access RST; Item : in Long_Unsigned) is
+ procedure W_LU (Stream : not null access RST; Item : Long_Unsigned) is
S : XDR_S_LU;
U : Unsigned;
X : Long_Unsigned := Item;
@@ -1584,7 +1584,7 @@ package body System.Stream_Attributes is
-- W_SF --
----------
- procedure W_SF (Stream : not null access RST; Item : in Short_Float) is
+ procedure W_SF (Stream : not null access RST; Item : Short_Float) is
I : constant Precision := Single;
E_Size : Integer renames Fields (I).E_Size;
E_Bias : Integer renames Fields (I).E_Bias;
@@ -1666,7 +1666,7 @@ package body System.Stream_Attributes is
-- W_SI --
----------
- procedure W_SI (Stream : not null access RST; Item : in Short_Integer) is
+ procedure W_SI (Stream : not null access RST; Item : Short_Integer) is
S : XDR_S_SI;
U : XDR_SU;
@@ -1702,7 +1702,7 @@ package body System.Stream_Attributes is
procedure W_SSI
(Stream : not null access RST;
- Item : in Short_Short_Integer)
+ Item : Short_Short_Integer)
is
S : XDR_S_SSI;
U : XDR_SSU;
@@ -1732,7 +1732,7 @@ package body System.Stream_Attributes is
procedure W_SSU
(Stream : not null access RST;
- Item : in Short_Short_Unsigned)
+ Item : Short_Short_Unsigned)
is
U : constant XDR_SSU := XDR_SSU (Item);
S : XDR_S_SSU;
@@ -1747,7 +1747,7 @@ package body System.Stream_Attributes is
-- W_SU --
----------
- procedure W_SU (Stream : not null access RST; Item : in Short_Unsigned) is
+ procedure W_SU (Stream : not null access RST; Item : Short_Unsigned) is
S : XDR_S_SU;
U : XDR_SU := XDR_SU (Item);
@@ -1772,7 +1772,7 @@ package body System.Stream_Attributes is
-- W_U --
---------
- procedure W_U (Stream : not null access RST; Item : in Unsigned) is
+ procedure W_U (Stream : not null access RST; Item : Unsigned) is
S : XDR_S_U;
U : XDR_U := XDR_U (Item);
@@ -1797,7 +1797,7 @@ package body System.Stream_Attributes is
-- W_WC --
----------
- procedure W_WC (Stream : not null access RST; Item : in Wide_Character) is
+ procedure W_WC (Stream : not null access RST; Item : Wide_Character) is
S : XDR_S_WC;
U : XDR_WC;
diff --git a/gcc/ada/s-trafor-default.adb b/gcc/ada/s-trafor-default.adb
index 1918cae..4451f43 100644
--- a/gcc/ada/s-trafor-default.adb
+++ b/gcc/ada/s-trafor-default.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006 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- --
@@ -41,7 +41,7 @@ package body System.Traces.Format is
-- Format_Trace --
------------------
- function Format_Trace (Source : in String) return String_Trace is
+ function Format_Trace (Source : String) return String_Trace is
Length : Integer := Source'Length;
Result : String_Trace := (others => ' ');
diff --git a/gcc/ada/s-wchcon.adb b/gcc/ada/s-wchcon.adb
index ad55243..9cbea7f 100755
--- a/gcc/ada/s-wchcon.adb
+++ b/gcc/ada/s-wchcon.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -48,4 +48,17 @@ package body System.WCh_Con is
raise Constraint_Error;
end Get_WC_Encoding_Method;
+ function Get_WC_Encoding_Method (S : String) return WC_Encoding_Method is
+ begin
+ if S = "hex" then return WCEM_Hex;
+ elsif S = "upper" then return WCEM_Upper;
+ elsif S = "shift_jis" then return WCEM_Shift_JIS;
+ elsif S = "euc" then return WCEM_EUC;
+ elsif S = "utf8" then return WCEM_UTF8;
+ elsif S = "brackets" then return WCEM_Brackets;
+ else
+ raise Constraint_Error;
+ end if;
+ end Get_WC_Encoding_Method;
+
end System.WCh_Con;
diff --git a/gcc/ada/s-wchcon.ads b/gcc/ada/s-wchcon.ads
index d0c9b8f..6ae05af 100644
--- a/gcc/ada/s-wchcon.ads
+++ b/gcc/ada/s-wchcon.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -186,4 +186,9 @@ package System.WCh_Con is
-- Given a character C, returns corresponding encoding method (see array
-- WC_Encoding_Letters above). Raises Constraint_Error if not in list.
+ function Get_WC_Encoding_Method (S : String) return WC_Encoding_Method;
+ -- Given a lower case string that is one of hex, upper, shift_jis, euc,
+ -- utf8, brackets, return the corresponding encoding method. Raises
+ -- Constraint_Error if not in list.
+
end System.WCh_Con;
diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb
index 52a9fac..6f8ea91 100644
--- a/gcc/ada/scn.adb
+++ b/gcc/ada/scn.adb
@@ -57,45 +57,6 @@ package body Scn is
procedure Error_Long_Line;
-- Signal error of excessively long line
- ---------------
- -- Post_Scan --
- ---------------
-
- procedure Post_Scan is
- begin
- case Token is
- when Tok_Char_Literal =>
- Token_Node := New_Node (N_Character_Literal, Token_Ptr);
- Set_Char_Literal_Value (Token_Node, UI_From_CC (Character_Code));
- Set_Chars (Token_Node, Token_Name);
-
- when Tok_Identifier =>
- Token_Node := New_Node (N_Identifier, Token_Ptr);
- Set_Chars (Token_Node, Token_Name);
-
- when Tok_Real_Literal =>
- Token_Node := New_Node (N_Real_Literal, Token_Ptr);
- Set_Realval (Token_Node, Real_Literal_Value);
-
- when Tok_Integer_Literal =>
- Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
- Set_Intval (Token_Node, Int_Literal_Value);
-
- when Tok_String_Literal =>
- Token_Node := New_Node (N_String_Literal, Token_Ptr);
- Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
- Set_Strval (Token_Node, String_Literal_Id);
-
- when Tok_Operator_Symbol =>
- Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
- Set_Chars (Token_Node, Token_Name);
- Set_Strval (Token_Node, String_Literal_Id);
-
- when others =>
- null;
- end case;
- end Post_Scan;
-
-----------------------
-- Check_End_Of_Line --
-----------------------
@@ -345,6 +306,45 @@ package body Scn is
Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
end Obsolescent_Check;
+ ---------------
+ -- Post_Scan --
+ ---------------
+
+ procedure Post_Scan is
+ begin
+ case Token is
+ when Tok_Char_Literal =>
+ Token_Node := New_Node (N_Character_Literal, Token_Ptr);
+ Set_Char_Literal_Value (Token_Node, UI_From_CC (Character_Code));
+ Set_Chars (Token_Node, Token_Name);
+
+ when Tok_Identifier =>
+ Token_Node := New_Node (N_Identifier, Token_Ptr);
+ Set_Chars (Token_Node, Token_Name);
+
+ when Tok_Real_Literal =>
+ Token_Node := New_Node (N_Real_Literal, Token_Ptr);
+ Set_Realval (Token_Node, Real_Literal_Value);
+
+ when Tok_Integer_Literal =>
+ Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
+ Set_Intval (Token_Node, Int_Literal_Value);
+
+ when Tok_String_Literal =>
+ Token_Node := New_Node (N_String_Literal, Token_Ptr);
+ Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
+ Set_Strval (Token_Node, String_Literal_Id);
+
+ when Tok_Operator_Symbol =>
+ Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
+ Set_Chars (Token_Node, Token_Name);
+ Set_Strval (Token_Node, String_Literal_Id);
+
+ when others =>
+ null;
+ end case;
+ end Post_Scan;
+
------------------------------
-- Scan_Reserved_Identifier --
------------------------------
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index b6523da..78d8798 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -558,6 +558,8 @@ package body Sem_Case is
Raises_CE : out Boolean;
Others_Present : out Boolean)
is
+ pragma Assert (Choice_Table'First = 1);
+
E : Entity_Id;
Enode : Node_Id;
diff --git a/gcc/ada/sem_case.ads b/gcc/ada/sem_case.ads
index e07e229..66009c2 100644
--- a/gcc/ada/sem_case.ads
+++ b/gcc/ada/sem_case.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -93,8 +93,8 @@ package Sem_Case is
-- Subtyp is the subtype of the discrete choices. The type against
-- which the discrete choices must be resolved is its base type.
--
- -- On entry Choice_Table must be big enough to contain all the
- -- discrete choices encountered.
+ -- On entry Choice_Table must be big enough to contain all the discrete
+ -- choices encountered. The lower bound of Choice_Table must be one.
--
-- On exit Choice_Table contains all the static and non empty discrete
-- choices in sorted order. Last_Choice gives the position of the last
diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb
index 9e29dbc..b1062b7 100644
--- a/gcc/ada/sinput-l.adb
+++ b/gcc/ada/sinput-l.adb
@@ -652,8 +652,8 @@ package body Sinput.L is
-- We scan past junk to the first interesting compilation unit
-- token, to see if it is SEPARATE. We ignore WITH keywords during
-- this and also PRIVATE. The reason for ignoring PRIVATE is that
- -- it handles some error situations, and also it is possible that
- -- a PRIVATE WITH feature might be approved some time in the future.
+ -- it handles some error situations, and also to handle PRIVATE WITH
+ -- in Ada 2005 mode.
while Token = Tok_With
or else Token = Tok_Private
diff --git a/gcc/ada/sinput-p.adb b/gcc/ada/sinput-p.adb
index a333b09..4718952 100644
--- a/gcc/ada/sinput-p.adb
+++ b/gcc/ada/sinput-p.adb
@@ -89,8 +89,8 @@ package body Sinput.P is
-- We scan past junk to the first interesting compilation unit
-- token, to see if it is SEPARATE. We ignore WITH keywords during
-- this and also PRIVATE. The reason for ignoring PRIVATE is that
- -- it handles some error situations, and also it is possible that
- -- a PRIVATE WITH feature might be approved some time in the future.
+ -- it handles some error situations, and also to handle PRIVATE WITH
+ -- in Ada 2005 mode.
while Token = Tok_With
or else Token = Tok_Private
diff --git a/gcc/ada/treeprs.adt b/gcc/ada/treeprs.adt
index fbffd58..9de0654 100644
--- a/gcc/ada/treeprs.adt
+++ b/gcc/ada/treeprs.adt
@@ -6,7 +6,7 @@
-- --
-- T e m p l a t e --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -47,9 +47,9 @@ package Treeprs is
-- by the synonym name. The starting location for a given node type is
-- found from the corresponding entry in the Pchars_Pos_Array.
- -- The following characters identify the field. These are characters
- -- which could never occur in a field name, so they also mark the
- -- end of the previous name.
+ -- The following characters identify the field. These are characters which
+ -- could never occur in a field name, so they also mark the end of the
+ -- previous name.
subtype Fchar is Character range '#' .. '9';
@@ -79,9 +79,9 @@ package Treeprs is
-- Note this table does not include entity field and flags whose access
-- functions are in Einfo (these are handled by the Print_Entity_Info
- -- procedure in Treepr, which uses the routines in Einfo to get the
- -- proper symbolic information). In addition, the following fields are
- -- handled by Treepr, and do not appear in the Pchars array:
+ -- procedure in Treepr, which uses the routines in Einfo to get the proper
+ -- symbolic information). In addition, the following fields are handled by
+ -- Treepr, and do not appear in the Pchars array:
-- Analyzed
-- Cannot_Be_Constant
diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb
index d295eab..7c711ab 100644
--- a/gcc/ada/uintp.adb
+++ b/gcc/ada/uintp.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -134,6 +134,7 @@ package body Uintp is
-- digit of Vec contains the sign, all other digits are always non-
-- negative. Note that the input may be directly represented, and in
-- this case Vec will contain the corresponding one or two digit value.
+ -- The low bound of Vec is always 1.
function Least_Sig_Digit (Arg : Uint) return Int;
pragma Inline (Least_Sig_Digit);
@@ -422,6 +423,8 @@ package body Uintp is
procedure Init_Operand (UI : Uint; Vec : out UI_Vector) is
Loc : Int;
+ pragma Assert (Vec'First = Int'(1));
+
begin
if Direct (UI) then
Vec (1) := Direct_Val (UI);
@@ -590,18 +593,28 @@ package body Uintp is
Num : Nat;
begin
+ -- Largest negative number has to be handled specially, since it is in
+ -- Int_Range, but we cannot take the absolute value.
+
if Input = Uint_Int_First then
return Int'Size;
+ -- For any other number in Int_Range, get absolute value of number
+
elsif UI_Is_In_Int_Range (Input) then
Num := abs (UI_To_Int (Input));
Bits := 0;
+ -- If not in Int_Range then initialize bit count for all low order
+ -- words, and set number to high order digit.
+
else
Bits := Base_Bits * (Uints.Table (Input).Length - 1);
Num := abs (Udigits.Table (Uints.Table (Input).Loc));
end if;
+ -- Increase bit count for remaining value in Num
+
while Types.">" (Num, 0) loop
Num := Num / 2;
Bits := Bits + 1;
diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb
index c1839af..4897bf1 100644
--- a/gcc/ada/urealp.adb
+++ b/gcc/ada/urealp.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -1431,14 +1431,14 @@ package body Urealp is
return UR_10_36;
end Ureal_10_36;
- -------------------
- -- Ureal_M_10_36 --
- -------------------
+ ----------------
+ -- Ureal_2_80 --
+ ----------------
- function Ureal_M_10_36 return Ureal is
+ function Ureal_2_80 return Ureal is
begin
- return UR_M_10_36;
- end Ureal_M_10_36;
+ return UR_2_80;
+ end Ureal_2_80;
-----------------
-- Ureal_2_128 --
@@ -1449,14 +1449,14 @@ package body Urealp is
return UR_2_128;
end Ureal_2_128;
- ----------------
- -- Ureal_2_80 --
- ----------------
+ -------------------
+ -- Ureal_2_M_80 --
+ -------------------
- function Ureal_2_80 return Ureal is
+ function Ureal_2_M_80 return Ureal is
begin
- return UR_2_80;
- end Ureal_2_80;
+ return UR_2_M_80;
+ end Ureal_2_M_80;
-------------------
-- Ureal_2_M_128 --
@@ -1467,15 +1467,6 @@ package body Urealp is
return UR_2_M_128;
end Ureal_2_M_128;
- -------------------
- -- Ureal_2_M_80 --
- -------------------
-
- function Ureal_2_M_80 return Ureal is
- begin
- return UR_2_M_80;
- end Ureal_2_M_80;
-
----------------
-- Ureal_Half --
----------------
@@ -1494,6 +1485,15 @@ package body Urealp is
return UR_M_0;
end Ureal_M_0;
+ -------------------
+ -- Ureal_M_10_36 --
+ -------------------
+
+ function Ureal_M_10_36 return Ureal is
+ begin
+ return UR_M_10_36;
+ end Ureal_M_10_36;
+
-----------------
-- Ureal_Tenth --
-----------------