From 35c57fc720ac63d3be352909ae6d632cdc471e2f Mon Sep 17 00:00:00 2001
From: charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri, 9 Dec 2005 17:22:27 +0000
Subject: [PATCH] 2005-12-05 Robert Dewar <dewar@adacore.com>
* i-c.adb, i-cexten.ads, i-cobol.adb, i-cobol.ads, i-cpoint.ads,
i-cpp.adb, i-cpp.ads, i-cstrea.ads, i-cstrin.adb, i-cstrin.ads,
inline.adb, interfac.ads, i-os2err.ads, i-os2lib.ads, i-os2syn.ads,
i-os2thr.ads, itypes.adb, itypes.adb, itypes.ads, krunch.ads,
krunch.adb, lib.adb, lib.ads, lib-list.adb, lib-load.adb,
lib-load.ads, lib-sort.adb, live.adb, make.ads, i-cstrea-vms.adb,
interfac-vms.ads, makegpr.adb, indepsw-gnu.adb, indepsw.ads,
s-wchcon.ads, sdefault.ads, sem_ch10.adb, sem_eval.ads: Minor
reformatting.
2005-12-05 Robert Dewar <dewar@adacore.com>
* s-vaflop-vms-alpha.adb: (Ne_F): New function
(Ne_G): New function
* exp_ch4.adb (Expand_Allocator_Expression): Factor duplicated code
for tag assignment.
(Rewrite_Comparison): Handle case where operation is not a comparison
and ignore, and also handle type conversion case.
2005-12-05 Thomas Quinot <quinot@adacore.com>
* exp_aggr.ads: Fix typo in comment.
???-mark Convert_Aggr_In_Assignment as needing documentation.
2005-12-05 Gary Dismukes <dismukes@adacore.com>
* layout.adb: Replace various uses of byte by storage unit throughout.
(Get_Max_SU_Size): Name changed from Get_Max_Size. In the case of a
static size, convert to storage units before returning, to conform to
spec.
2005-12-05 Matthew Gingell <gingell@adacore.com>
* g-exctra.ads: Fix typo in comment.
2005-12-05 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* utils.c: Minor reformatting.
2005-12-05 Robert Dewar <dewar@adacore.com>
* g-soccon.ads:
Further comment fixes to make the status of the default file clear
* s-bitops.adb: Clarify comment for Bits_Array
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108308 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/ada/exp_aggr.ads | 9 +-
gcc/ada/exp_ch4.adb | 228 ++++++++++---------
gcc/ada/g-exctra.ads | 2 +-
gcc/ada/g-soccon.ads | 9 +-
gcc/ada/i-c.adb | 2 +-
gcc/ada/i-cexten.ads | 2 +-
gcc/ada/i-cobol.adb | 2 +-
gcc/ada/i-cobol.ads | 2 +-
gcc/ada/i-cpoint.ads | 2 +-
gcc/ada/i-cpp.adb | 2 +-
gcc/ada/i-cpp.ads | 2 +-
gcc/ada/i-cstrea-vms.adb | 2 +-
gcc/ada/i-cstrea.ads | 2 +-
gcc/ada/i-cstrin.adb | 2 +-
gcc/ada/i-cstrin.ads | 2 +-
gcc/ada/i-os2err.ads | 2 +-
gcc/ada/i-os2lib.ads | 2 +-
gcc/ada/i-os2syn.ads | 2 +-
gcc/ada/i-os2thr.ads | 2 +-
gcc/ada/indepsw-gnu.adb | 2 +-
gcc/ada/indepsw.ads | 2 +-
gcc/ada/inline.adb | 2 +-
gcc/ada/interfac-vms.ads | 2 +-
gcc/ada/interfac.ads | 2 +-
gcc/ada/itypes.adb | 42 ++--
gcc/ada/itypes.ads | 5 +-
gcc/ada/krunch.adb | 3 +-
gcc/ada/krunch.ads | 2 +-
gcc/ada/layout.adb | 38 ++--
gcc/ada/lib-list.adb | 2 +-
gcc/ada/lib-load.adb | 2 +-
gcc/ada/lib-load.ads | 2 +-
gcc/ada/lib-sort.adb | 2 +-
gcc/ada/lib.adb | 2 +-
gcc/ada/lib.ads | 2 +-
gcc/ada/live.adb | 2 +-
gcc/ada/make.ads | 2 +-
gcc/ada/makegpr.adb | 2 +-
gcc/ada/s-bitops.adb | 5 +-
gcc/ada/s-vaflop-vms-alpha.adb | 101 ++++-----
gcc/ada/s-wchcon.ads | 2 +-
gcc/ada/sdefault.ads | 18 +-
gcc/ada/sem_ch10.adb | 2 +-
gcc/ada/sem_eval.ads | 402 ++++++++++++++++-----------------
gcc/ada/utils.c | 7 +-
45 files changed, 463 insertions(+), 470 deletions(-)
diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads
index 6c0ad947cae0..664e654a9993 100644
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -43,12 +43,9 @@ package Exp_Aggr is
-- Decl is an access N_Object_Declaration (produced during
-- allocator expansion), Aggr is the initial expression aggregate
-- of an allocator. This procedure perform in-place aggregate
- -- assignent in the newly allocated object.
+ -- assignment in the newly allocated object.
procedure Convert_Aggr_In_Assignment (N : Node_Id);
- -- Decl is an access N_Object_Declaration (produced during
- -- allocator expansion), Aggr is the initial expression aggregate
- -- of an allocator. This procedure perform in-place aggregate
- -- assignent in the newly allocated object.
+ -- ??? documentation needed
end Exp_Aggr;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 2e1f38f88e41..e1da11baedf8 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -192,10 +192,12 @@ package body Exp_Ch4 is
-- this by using Convert_To_Actual_Subtype if necessary).
procedure Rewrite_Comparison (N : Node_Id);
- -- N is the node for a compile time comparison. If this outcome of this
- -- comparison can be determined at compile time, then the node N can be
- -- rewritten with True or False. If the outcome cannot be determined at
- -- compile time, the call has no effect.
+ -- if N is the node for a comparison whose outcome can be determined at
+ -- compile time, then the node N can be rewritten with True or False. If
+ -- the outcome cannot be determined at compile time, the call has no
+ -- effect. If N is a type conversion, then this processing is applied to
+ -- its expression. If N is neither comparison nor a type conversion, the
+ -- call has no effect.
function Tagged_Membership (N : Node_Id) return Node_Id;
-- Construct the expression corresponding to the tagged membership test.
@@ -372,6 +374,12 @@ package body Exp_Ch4 is
Node : Node_Id;
Temp : Entity_Id;
+ TagT : Entity_Id := Empty;
+ -- Type used as source for tag assignment
+
+ TagR : Node_Id := Empty;
+ -- Target reference for tag assignment
+
Aggr_In_Place : constant Boolean := Is_Delayed_Aggregate (Exp);
Tag_Assign : Node_Id;
@@ -484,61 +492,46 @@ package body Exp_Ch4 is
Reason => PE_Accessibility_Check_Failed));
end if;
- -- Suppress the tag assignment when Java_VM because JVM tags
- -- are represented implicitly in objects.
+ if Java_VM then
- if Is_Tagged_Type (T)
- and then not Is_Class_Wide_Type (T)
- and then not Java_VM
+ -- Suppress the tag assignment when Java_VM because JVM tags
+ -- are represented implicitly in objects.
+
+ null;
+
+ elsif Is_Tagged_Type (T) and then not Is_Class_Wide_Type (T) then
+ TagT := T;
+ TagR := New_Reference_To (Temp, Loc);
+
+ elsif Is_Private_Type (T)
+ and then Is_Tagged_Type (Underlying_Type (T))
then
+ TagT := Underlying_Type (T);
+ TagR := Unchecked_Convert_To (Underlying_Type (T),
+ Make_Explicit_Dereference (Loc,
+ New_Reference_To (Temp, Loc)));
+
+ end if;
+
+ if Present (TagT) then
Tag_Assign :=
Make_Assignment_Statement (Loc,
Name =>
Make_Selected_Component (Loc,
- Prefix => New_Reference_To (Temp, Loc),
+ Prefix => TagR,
Selector_Name =>
- New_Reference_To (First_Tag_Component (T), Loc)),
+ New_Reference_To (First_Tag_Component (TagT), Loc)),
Expression =>
Unchecked_Convert_To (RTE (RE_Tag),
New_Reference_To
- (Elists.Node (First_Elmt (Access_Disp_Table (T))),
+ (Elists.Node (First_Elmt (Access_Disp_Table (TagT))),
Loc)));
-- The previous assignment has to be done in any case
Set_Assignment_OK (Name (Tag_Assign));
Insert_Action (N, Tag_Assign);
-
- elsif Is_Private_Type (T)
- and then Is_Tagged_Type (Underlying_Type (T))
- and then not Java_VM
- then
- declare
- Utyp : constant Entity_Id := Underlying_Type (T);
- Ref : constant Node_Id :=
- Unchecked_Convert_To (Utyp,
- Make_Explicit_Dereference (Loc,
- New_Reference_To (Temp, Loc)));
-
- begin
- Tag_Assign :=
- Make_Assignment_Statement (Loc,
- Name =>
- Make_Selected_Component (Loc,
- Prefix => Ref,
- Selector_Name =>
- New_Reference_To (First_Tag_Component (Utyp), Loc)),
-
- Expression =>
- Unchecked_Convert_To (RTE (RE_Tag),
- New_Reference_To (
- Elists.Node (First_Elmt (Access_Disp_Table (Utyp))),
- Loc)));
-
- Set_Assignment_OK (Name (Tag_Assign));
- Insert_Action (N, Tag_Assign);
- end;
end if;
if Controlled_Type (DesigT)
@@ -3530,7 +3523,6 @@ package body Exp_Ch4 is
Parnt := Parent (Child);
end loop;
end;
-
end Expand_N_Indexed_Component;
---------------------
@@ -4570,12 +4562,9 @@ package body Exp_Ch4 is
end if;
end if;
- -- If we still have an equality comparison (i.e. it was not rewritten
- -- in some way), then we can test if result is known at compile time).
+ -- Test if result is known at compile time
- if Nkind (N) = N_Op_Eq then
- Rewrite_Comparison (N);
- end if;
+ Rewrite_Comparison (N);
-- If we still have comparison for Vax_Float, process it
@@ -8010,78 +7999,91 @@ package body Exp_Ch4 is
------------------------
procedure Rewrite_Comparison (N : Node_Id) is
- Typ : constant Entity_Id := Etype (N);
- Op1 : constant Node_Id := Left_Opnd (N);
- Op2 : constant Node_Id := Right_Opnd (N);
+ begin
+ if Nkind (N) = N_Type_Conversion then
+ Rewrite_Comparison (Expression (N));
- Res : constant Compare_Result := Compile_Time_Compare (Op1, Op2);
- -- Res indicates if compare outcome can be determined at compile time
+ elsif Nkind (N) not in N_Op_Compare then
+ null;
- True_Result : Boolean;
- False_Result : Boolean;
+ else
+ declare
+ Typ : constant Entity_Id := Etype (N);
+ Op1 : constant Node_Id := Left_Opnd (N);
+ Op2 : constant Node_Id := Right_Opnd (N);
- begin
- case N_Op_Compare (Nkind (N)) is
- when N_Op_Eq =>
- True_Result := Res = EQ;
- False_Result := Res = LT or else Res = GT or else Res = NE;
-
- when N_Op_Ge =>
- True_Result := Res in Compare_GE;
- False_Result := Res = LT;
-
- if Res = LE
- and then Constant_Condition_Warnings
- and then Comes_From_Source (Original_Node (N))
- and then Nkind (Original_Node (N)) = N_Op_Ge
- and then not In_Instance
- and then not Warnings_Off (Etype (Left_Opnd (N)))
- and then Is_Integer_Type (Etype (Left_Opnd (N)))
- then
- Error_Msg_N
- ("can never be greater than, could replace by ""'=""?", N);
- end if;
+ Res : constant Compare_Result := Compile_Time_Compare (Op1, Op2);
+ -- Res indicates if compare outcome can be compile time determined
- when N_Op_Gt =>
- True_Result := Res = GT;
- False_Result := Res in Compare_LE;
-
- when N_Op_Lt =>
- True_Result := Res = LT;
- False_Result := Res in Compare_GE;
-
- when N_Op_Le =>
- True_Result := Res in Compare_LE;
- False_Result := Res = GT;
-
- if Res = GE
- and then Constant_Condition_Warnings
- and then Comes_From_Source (Original_Node (N))
- and then Nkind (Original_Node (N)) = N_Op_Le
- and then not In_Instance
- and then not Warnings_Off (Etype (Left_Opnd (N)))
- and then Is_Integer_Type (Etype (Left_Opnd (N)))
- then
- Error_Msg_N
- ("can never be less than, could replace by ""'=""?", N);
- end if;
+ True_Result : Boolean;
+ False_Result : Boolean;
- when N_Op_Ne =>
- True_Result := Res = NE or else Res = GT or else Res = LT;
- False_Result := Res = EQ;
- end case;
+ begin
+ case N_Op_Compare (Nkind (N)) is
+ when N_Op_Eq =>
+ True_Result := Res = EQ;
+ False_Result := Res = LT or else Res = GT or else Res = NE;
+
+ when N_Op_Ge =>
+ True_Result := Res in Compare_GE;
+ False_Result := Res = LT;
+
+ if Res = LE
+ and then Constant_Condition_Warnings
+ and then Comes_From_Source (Original_Node (N))
+ and then Nkind (Original_Node (N)) = N_Op_Ge
+ and then not In_Instance
+ and then not Warnings_Off (Etype (Left_Opnd (N)))
+ and then Is_Integer_Type (Etype (Left_Opnd (N)))
+ then
+ Error_Msg_N
+ ("can never be greater than, could replace by ""'=""?", N);
+ end if;
- if True_Result then
- Rewrite (N,
- Convert_To (Typ, New_Occurrence_Of (Standard_True, Sloc (N))));
- Analyze_And_Resolve (N, Typ);
- Warn_On_Known_Condition (N);
+ when N_Op_Gt =>
+ True_Result := Res = GT;
+ False_Result := Res in Compare_LE;
+
+ when N_Op_Lt =>
+ True_Result := Res = LT;
+ False_Result := Res in Compare_GE;
+
+ when N_Op_Le =>
+ True_Result := Res in Compare_LE;
+ False_Result := Res = GT;
+
+ if Res = GE
+ and then Constant_Condition_Warnings
+ and then Comes_From_Source (Original_Node (N))
+ and then Nkind (Original_Node (N)) = N_Op_Le
+ and then not In_Instance
+ and then not Warnings_Off (Etype (Left_Opnd (N)))
+ and then Is_Integer_Type (Etype (Left_Opnd (N)))
+ then
+ Error_Msg_N
+ ("can never be less than, could replace by ""'=""?", N);
+ end if;
- elsif False_Result then
- Rewrite (N,
- Convert_To (Typ, New_Occurrence_Of (Standard_False, Sloc (N))));
- Analyze_And_Resolve (N, Typ);
- Warn_On_Known_Condition (N);
+ when N_Op_Ne =>
+ True_Result := Res = NE or else Res = GT or else Res = LT;
+ False_Result := Res = EQ;
+ end case;
+
+ if True_Result then
+ Rewrite (N,
+ Convert_To (Typ,
+ New_Occurrence_Of (Standard_True, Sloc (N))));
+ Analyze_And_Resolve (N, Typ);
+ Warn_On_Known_Condition (N);
+
+ elsif False_Result then
+ Rewrite (N,
+ Convert_To (Typ,
+ New_Occurrence_Of (Standard_False, Sloc (N))));
+ Analyze_And_Resolve (N, Typ);
+ Warn_On_Known_Condition (N);
+ end if;
+ end;
end if;
end Rewrite_Comparison;
diff --git a/gcc/ada/g-exctra.ads b/gcc/ada/g-exctra.ads
index b11a23e2e91a..eb0d5a6c4289 100644
--- a/gcc/ada/g-exctra.ads
+++ b/gcc/ada/g-exctra.ads
@@ -44,7 +44,7 @@
-- The default backtrace is in the form of absolute code locations which may
-- be converted to corresponding source locations using the addr2line utility
-- or from within GDB. Please refer to GNAT.Traceback for information about
--- what is necessary to be able to exploit thisg possibility.
+-- what is necessary to be able to exploit this possibility.
-- The backtrace output can also be customized by way of a "decorator" which
-- may return any string output in association with a provided call chain.
diff --git a/gcc/ada/g-soccon.ads b/gcc/ada/g-soccon.ads
index f2f00554efde..679a98613a82 100644
--- a/gcc/ada/g-soccon.ads
+++ b/gcc/ada/g-soccon.ads
@@ -36,11 +36,12 @@
-- directly with'ed by an applications program.
-- WARNING! This file is a default version that must be replaced for
--- each platform.
--- The values below were computed from a i686-pc-linux-gnu environment.
+-- each platform by running gen-soccon.c which automatically generates
+-- the appropriate target specific values.
--- This file is generated automatically, do not modify it by hand! Instead,
--- make changes to gen-soccon.c and re-run it on each target.
+-- The values below were computed from a i686-pc-linux-gnu environment,
+-- but are for illustration purposes only. As noted above, part of a port
+-- to a new target is to replace this file appropriately.
package GNAT.Sockets.Constants is
diff --git a/gcc/ada/i-c.adb b/gcc/ada/i-c.adb
index ea044772b085..82687568b954 100644
--- a/gcc/ada/i-c.adb
+++ b/gcc/ada/i-c.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/i-cexten.ads b/gcc/ada/i-cexten.ads
index ed08fc912aee..d331fbd08302 100644
--- a/gcc/ada/i-cexten.ads
+++ b/gcc/ada/i-cexten.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/i-cobol.adb b/gcc/ada/i-cobol.adb
index fd30de8576f2..758c5066a01c 100644
--- a/gcc/ada/i-cobol.adb
+++ b/gcc/ada/i-cobol.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/i-cobol.ads b/gcc/ada/i-cobol.ads
index f474d69cc058..34ef56da6aa8 100644
--- a/gcc/ada/i-cobol.ads
+++ b/gcc/ada/i-cobol.ads
@@ -7,7 +7,7 @@
-- S p e c --
-- (ASCII Version) --
-- --
--- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2005, 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/i-cpoint.ads b/gcc/ada/i-cpoint.ads
index e473f57e10ed..80c2bfb27b8c 100644
--- a/gcc/ada/i-cpoint.ads
+++ b/gcc/ada/i-cpoint.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2005, 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/i-cpp.adb b/gcc/ada/i-cpp.adb
index 48658af555ae..55f4d3a68c53 100644
--- a/gcc/ada/i-cpp.adb
+++ b/gcc/ada/i-cpp.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/i-cpp.ads b/gcc/ada/i-cpp.ads
index e534f651f3c0..f5c42533c1ed 100644
--- a/gcc/ada/i-cpp.ads
+++ b/gcc/ada/i-cpp.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/i-cstrea-vms.adb b/gcc/ada/i-cstrea-vms.adb
index 9e34a96ea59a..1266280dadb5 100644
--- a/gcc/ada/i-cstrea-vms.adb
+++ b/gcc/ada/i-cstrea-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2005, 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/i-cstrea.ads b/gcc/ada/i-cstrea.ads
index af3279817c5a..a7a30b2d3c40 100644
--- a/gcc/ada/i-cstrea.ads
+++ b/gcc/ada/i-cstrea.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1995-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2005, 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/i-cstrin.adb b/gcc/ada/i-cstrin.adb
index 84c0e22f62da..226661f47621 100644
--- a/gcc/ada/i-cstrin.adb
+++ b/gcc/ada/i-cstrin.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/i-cstrin.ads b/gcc/ada/i-cstrin.ads
index d959bb5082e0..5ea063ab0ef2 100644
--- a/gcc/ada/i-cstrin.ads
+++ b/gcc/ada/i-cstrin.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2005, 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/i-os2err.ads b/gcc/ada/i-os2err.ads
index 21cbf84ccb5e..f837224ae6b4 100644
--- a/gcc/ada/i-os2err.ads
+++ b/gcc/ada/i-os2err.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2005, 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/i-os2lib.ads b/gcc/ada/i-os2lib.ads
index 45fa1aee6a63..ac5a65433ebf 100644
--- a/gcc/ada/i-os2lib.ads
+++ b/gcc/ada/i-os2lib.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2005, 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/i-os2syn.ads b/gcc/ada/i-os2syn.ads
index 844e2f0b7dd0..9dfa2c6dfe0d 100644
--- a/gcc/ada/i-os2syn.ads
+++ b/gcc/ada/i-os2syn.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2005, 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/i-os2thr.ads b/gcc/ada/i-os2thr.ads
index 1fd90496c3c2..97ac453d9fb5 100644
--- a/gcc/ada/i-os2thr.ads
+++ b/gcc/ada/i-os2thr.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2005, 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/indepsw-gnu.adb b/gcc/ada/indepsw-gnu.adb
index 44cd6bf65e2c..5698461ea486 100644
--- a/gcc/ada/indepsw-gnu.adb
+++ b/gcc/ada/indepsw-gnu.adb
@@ -7,7 +7,7 @@
-- B o d y --
-- (GNU version) --
-- --
--- Copyright (C) 2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2005, 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/indepsw.ads b/gcc/ada/indepsw.ads
index 7296291b35d7..ecab5bb75e0b 100644
--- a/gcc/ada/indepsw.ads
+++ b/gcc/ada/indepsw.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2005, 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/inline.adb b/gcc/ada/inline.adb
index 8b8004f51871..7847a1577d68 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-2005, 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/interfac-vms.ads b/gcc/ada/interfac-vms.ads
index 1705e1e19dfb..bdd0c59c72a1 100644
--- a/gcc/ada/interfac-vms.ads
+++ b/gcc/ada/interfac-vms.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2005, 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/interfac.ads b/gcc/ada/interfac.ads
index 38e5cdab736e..2f0cdf045949 100644
--- a/gcc/ada/interfac.ads
+++ b/gcc/ada/interfac.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2005, 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/itypes.adb b/gcc/ada/itypes.adb
index f9f86d57e2e4..4b65da2c7578 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-2005, 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- --
@@ -24,11 +24,11 @@
-- --
------------------------------------------------------------------------------
-with Atree; use Atree;
-with Opt; use Opt;
-with Sem; use Sem;
-with Sinfo; use Sinfo;
-with Stand; use Stand;
+with Atree; use Atree;
+with Opt; use Opt;
+with Sem; use Sem;
+with Sinfo; use Sinfo;
+with Stand; use Stand;
package body Itypes is
@@ -42,8 +42,7 @@ package body Itypes is
Related_Id : Entity_Id := Empty;
Suffix : Character := ' ';
Suffix_Index : Nat := 0;
- Scope_Id : Entity_Id := Current_Scope)
- return Entity_Id
+ Scope_Id : Entity_Id := Current_Scope) return Entity_Id
is
Typ : Entity_Id;
@@ -90,20 +89,19 @@ package body Itypes is
Related_Nod => Related_Nod,
Scope_Id => Scope_Id);
- Set_Directly_Designated_Type (I_Typ,
- Directly_Designated_Type (T));
- 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_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_Can_Never_Be_Null (I_Typ);
+ Set_Directly_Designated_Type (I_Typ, Directly_Designated_Type (T));
+ 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_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_Can_Never_Be_Null (I_Typ);
return I_Typ;
end Create_Null_Excluding_Itype;
diff --git a/gcc/ada/itypes.ads b/gcc/ada/itypes.ads
index e4dcffce707f..453a35b218ff 100644
--- a/gcc/ada/itypes.ads
+++ b/gcc/ada/itypes.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
@@ -85,8 +85,7 @@ package Itypes is
Related_Id : Entity_Id := Empty;
Suffix : Character := ' ';
Suffix_Index : Nat := 0;
- Scope_Id : Entity_Id := Current_Scope)
- return Entity_Id;
+ Scope_Id : Entity_Id := Current_Scope) return Entity_Id;
-- Used to create a new Itype.
--
-- Related_Nod is the node for which this Itype was created. It is
diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb
index b5e8c67b5ae4..53d6285f4100 100644
--- a/gcc/ada/krunch.adb
+++ b/gcc/ada/krunch.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
@@ -32,6 +32,7 @@
------------------------------------------------------------------------------
with Hostparm;
+
procedure Krunch
(Buffer : in out String;
Len : in out Natural;
diff --git a/gcc/ada/krunch.ads b/gcc/ada/krunch.ads
index 59f07bd9af47..f5dbdb9a8769 100644
--- a/gcc/ada/krunch.ads
+++ b/gcc/ada/krunch.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/layout.adb b/gcc/ada/layout.adb
index 736dd0dc6b43..b24b4d80010d 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2005, 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- --
@@ -107,7 +107,7 @@ package body Layout is
-- dynamic sizes in storage units. If the argument N is anything other
-- than an integer literal, it is returned unchanged, but if it is an
-- integer literal, then it is taken as a size in bits, and is replaced
- -- by the corresponding size in bytes.
+ -- by the corresponding size in storage units.
function Compute_Length (Lo : Node_Id; Hi : Node_Id) return Node_Id;
-- Given expressions for the low bound (Lo) and the high bound (Hi),
@@ -154,7 +154,7 @@ package body Layout is
-- resolved (which may not be the case yet if we build the expression
-- in this unit).
- function Get_Max_Size (E : Entity_Id) return Node_Id;
+ function Get_Max_SU_Size (E : Entity_Id) return Node_Id;
-- E is an array type or subtype that has at least one index bound that
-- is the value of a record discriminant. For such an array, the function
-- computes an expression that yields the maximum possible size of the
@@ -222,7 +222,7 @@ package body Layout is
Esize_Set := Has_Size_Clause (E);
end if;
- -- If size is known it must be a multiple of the byte size
+ -- If size is known it must be a multiple of the storage unit size
if Esize (E) mod SSU /= 0 then
@@ -230,10 +230,11 @@ package body Layout is
if Esize_Set then
Error_Msg_NE
- ("size for& not a multiple of byte size", Size_Clause (E), E);
+ ("size for& not a multiple of storage unit size",
+ Size_Clause (E), E);
return;
- -- Otherwise bump up size to a byte boundary
+ -- Otherwise bump up size to a storage unit boundary
else
Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU);
@@ -270,7 +271,7 @@ package body Layout is
-- In this situation, the initial alignment of t is 4, copied from
-- the Integer base type, but it is safe to reduce it to 1 at this
- -- stage, since we will only be loading a single byte.
+ -- stage, since we will only be loading a single storage unit.
if Is_Discrete_Type (Etype (E))
and then not Has_Alignment_Clause (E)
@@ -652,11 +653,11 @@ package body Layout is
end if;
end Expr_From_SO_Ref;
- ------------------
- -- Get_Max_Size --
- ------------------
+ ---------------------
+ -- Get_Max_SU_Size --
+ ---------------------
- function Get_Max_Size (E : Entity_Id) return Node_Id is
+ function Get_Max_SU_Size (E : Entity_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (E);
Indx : Node_Id;
Ityp : Entity_Id;
@@ -725,7 +726,7 @@ package body Layout is
end if;
end Min_Discrim;
- -- Start of processing for Get_Max_Size
+ -- Start of processing for Get_Max_SU_Size
begin
pragma Assert (Size_Depends_On_Discriminant (E));
@@ -859,10 +860,10 @@ package body Layout is
end loop;
-- Here after processing all bounds to set sizes. If the value is
- -- a constant, then it is bits, and we just return the value.
+ -- a constant, then it is bits, so we convert to storage units.
if Size.Status = Const then
- return Make_Integer_Literal (Loc, Size.Val);
+ return Bits_To_SU (Make_Integer_Literal (Loc, Size.Val));
-- Case where the value is dynamic
@@ -884,7 +885,7 @@ package body Layout is
return Size.Nod;
end if;
- end Get_Max_Size;
+ end Get_Max_SU_Size;
-----------------------
-- Layout_Array_Type --
@@ -1480,7 +1481,7 @@ package body Layout is
-- Get maximum size of previous component
if Size_Depends_On_Discriminant (Etype (Prev_Comp)) then
- Old_Maxsz := Get_Max_Size (Etype (Prev_Comp));
+ Old_Maxsz := Get_Max_SU_Size (Etype (Prev_Comp));
else
Old_Maxsz := Expr_From_SO_Ref (Loc, Old_Esiz, Prev_Comp);
end if;
@@ -2556,7 +2557,7 @@ package body Layout is
-- For scalar types, increase Object_Size to power of 2,
-- but not less than a storage unit in any case (i.e.,
- -- normally this means it will be byte addressable).
+ -- normally this means it will be storage-unit addressable).
if Is_Scalar_Type (E) then
if Size <= System_Storage_Unit then
@@ -2717,7 +2718,8 @@ package body Layout is
-- Size is known, alignment is not set
- -- Reset alignment to match size if size is exactly 2, 4, or 8 bytes
+ -- Reset alignment to match size if size is exactly 2, 4, or 8
+ -- storage units.
if Siz = 2 * System_Storage_Unit then
Align := 2;
diff --git a/gcc/ada/lib-list.adb b/gcc/ada/lib-list.adb
index 79029e3652ba..479a51e9791f 100644
--- a/gcc/ada/lib-list.adb
+++ b/gcc/ada/lib-list.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/lib-load.adb b/gcc/ada/lib-load.adb
index 92e74369c546..248c5fcf9015 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/lib-load.ads b/gcc/ada/lib-load.ads
index 81b91e97caa8..cd8555827de9 100644
--- a/gcc/ada/lib-load.ads
+++ b/gcc/ada/lib-load.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/lib-sort.adb b/gcc/ada/lib-sort.adb
index 477eec3db2f3..b59251655421 100644
--- a/gcc/ada/lib-sort.adb
+++ b/gcc/ada/lib-sort.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/lib.adb b/gcc/ada/lib.adb
index a5d476c34fc6..e02ebb0ed005 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/lib.ads b/gcc/ada/lib.ads
index e906ff25610e..159ccc317c04 100644
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/live.adb b/gcc/ada/live.adb
index df92d0d6e120..ceccbc0e6bc7 100644
--- a/gcc/ada/live.adb
+++ b/gcc/ada/live.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2005, 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/make.ads b/gcc/ada/make.ads
index f5c4d25d10c5..aba233db74f7 100644
--- a/gcc/ada/make.ads
+++ b/gcc/ada/make.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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/makegpr.adb b/gcc/ada/makegpr.adb
index 2e8f5c223556..c96396defb12 100644
--- a/gcc/ada/makegpr.adb
+++ b/gcc/ada/makegpr.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2005, 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/s-bitops.adb b/gcc/ada/s-bitops.adb
index 2224ff0a6501..e5f33b118f91 100644
--- a/gcc/ada/s-bitops.adb
+++ b/gcc/ada/s-bitops.adb
@@ -40,12 +40,13 @@ with Unchecked_Conversion;
package body System.Bit_Ops is
subtype Bits_Array is System.Unsigned_Types.Packed_Bytes1 (Positive);
- -- Constrained array used to interpret the address values. We use the
+ -- Dummy array type used to interpret the address values. We use the
-- unaligned version always, since this will handle both the aligned and
-- unaligned cases, and we always do these operations by bytes anyway.
-- Note: we use a ones origin array here so that the computations of the
-- length in bytes work correctly (give a non-negative value) for the
- -- case of zero length bit strings).
+ -- case of zero length bit strings). Note that we never allocate any
+ -- objects of this type (we can't because they would be absurdly big).
type Bits is access Bits_Array;
-- This is the actual type into which address values are converted
diff --git a/gcc/ada/s-vaflop-vms-alpha.adb b/gcc/ada/s-vaflop-vms-alpha.adb
index 5ab772d44772..92e62734ee75 100644
--- a/gcc/ada/s-vaflop-vms-alpha.adb
+++ b/gcc/ada/s-vaflop-vms-alpha.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2005, Free Software Foundation, Inc. --
-- (Version for Alpha OpenVMS) --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
@@ -58,14 +58,16 @@ package body System.Vax_Float_Operations is
-- we define variables of the corresponding IEEE type so that they are
-- passed and kept in the proper register class.
+ Debug_String_Buffer : String (1 .. 32);
+ -- Buffer used by all Debug_String_x routines for returning result
+
------------
-- D_To_G --
------------
function D_To_G (X : D) return G is
A, B : T;
- C : G;
-
+ C : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X));
Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
@@ -80,7 +82,6 @@ package body System.Vax_Float_Operations is
function F_To_G (X : F) return G is
A : T;
B : G;
-
begin
Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
@@ -98,6 +99,7 @@ package body System.Vax_Float_Operations is
begin
-- Because converting to a wider FP format is a no-op, we say
-- A is 64-bit even though we are loading 32 bits into it.
+
Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
B := S (Cvt_G_T (A));
@@ -110,8 +112,7 @@ package body System.Vax_Float_Operations is
function G_To_D (X : G) return D is
A, B : T;
- C : D;
-
+ C : D;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
@@ -127,7 +128,6 @@ package body System.Vax_Float_Operations is
A : T;
B : S;
C : F;
-
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A));
@@ -142,7 +142,6 @@ package body System.Vax_Float_Operations is
function G_To_Q (X : G) return Q is
A : T;
B : Q;
-
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A));
@@ -155,7 +154,6 @@ package body System.Vax_Float_Operations is
function G_To_T (X : G) return T is
A, B : T;
-
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
B := Cvt_G_T (A);
@@ -178,7 +176,6 @@ package body System.Vax_Float_Operations is
function Q_To_F (X : Q) return F is
A : S;
B : F;
-
begin
Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
@@ -192,7 +189,6 @@ package body System.Vax_Float_Operations is
function Q_To_G (X : Q) return G is
A : T;
B : G;
-
begin
Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
@@ -206,7 +202,6 @@ package body System.Vax_Float_Operations is
function S_To_F (X : S) return F is
A : S;
B : F;
-
begin
A := Cvt_T_F (T (X));
Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
@@ -229,7 +224,6 @@ package body System.Vax_Float_Operations is
function T_To_G (X : T) return G is
A : T;
B : G;
-
begin
A := Cvt_T_G (X);
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
@@ -242,8 +236,7 @@ package body System.Vax_Float_Operations is
function Abs_F (X : F) return F is
A, B : S;
- C : F;
-
+ C : F;
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
@@ -257,8 +250,7 @@ package body System.Vax_Float_Operations is
function Abs_G (X : G) return G is
A, B : T;
- C : G;
-
+ C : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
@@ -272,8 +264,7 @@ package body System.Vax_Float_Operations is
function Add_F (X, Y : F) return F is
X1, Y1, R : S;
- R1 : F;
-
+ R1 : F;
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
@@ -289,8 +280,7 @@ package body System.Vax_Float_Operations is
function Add_G (X, Y : G) return G is
X1, Y1, R : T;
- R1 : G;
-
+ R1 : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
@@ -331,13 +321,9 @@ package body System.Vax_Float_Operations is
-- Debug_String_D --
--------------------
- Debug_String_Buffer : String (1 .. 32);
- -- Buffer used by all Debug_String_x routines for returning result
-
function Debug_String_D (Arg : D) return System.Address is
- Image_String : constant String := D'Image (Arg) & ASCII.NUL;
+ Image_String : constant String := D'Image (Arg) & ASCII.NUL;
Image_Size : constant Integer := Image_String'Length;
-
begin
Debug_String_Buffer (1 .. Image_Size) := Image_String;
return Debug_String_Buffer (1)'Address;
@@ -348,9 +334,8 @@ package body System.Vax_Float_Operations is
--------------------
function Debug_String_F (Arg : F) return System.Address is
- Image_String : constant String := F'Image (Arg) & ASCII.NUL;
+ Image_String : constant String := F'Image (Arg) & ASCII.NUL;
Image_Size : constant Integer := Image_String'Length;
-
begin
Debug_String_Buffer (1 .. Image_Size) := Image_String;
return Debug_String_Buffer (1)'Address;
@@ -361,9 +346,8 @@ package body System.Vax_Float_Operations is
--------------------
function Debug_String_G (Arg : G) return System.Address is
- Image_String : constant String := G'Image (Arg) & ASCII.NUL;
+ Image_String : constant String := G'Image (Arg) & ASCII.NUL;
Image_Size : constant Integer := Image_String'Length;
-
begin
Debug_String_Buffer (1 .. Image_Size) := Image_String;
return Debug_String_Buffer (1)'Address;
@@ -375,8 +359,7 @@ package body System.Vax_Float_Operations is
function Div_F (X, Y : F) return F is
X1, Y1, R : S;
-
- R1 : F;
+ R1 : F;
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
@@ -392,8 +375,7 @@ package body System.Vax_Float_Operations is
function Div_G (X, Y : G) return G is
X1, Y1, R : T;
- R1 : G;
-
+ R1 : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
@@ -409,7 +391,6 @@ package body System.Vax_Float_Operations is
function Eq_F (X, Y : F) return Boolean is
X1, Y1, R : S;
-
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
@@ -424,7 +405,6 @@ package body System.Vax_Float_Operations is
function Eq_G (X, Y : G) return Boolean is
X1, Y1, R : T;
-
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
@@ -439,7 +419,6 @@ package body System.Vax_Float_Operations is
function Le_F (X, Y : F) return Boolean is
X1, Y1, R : S;
-
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
@@ -454,7 +433,6 @@ package body System.Vax_Float_Operations is
function Le_G (X, Y : G) return Boolean is
X1, Y1, R : T;
-
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
@@ -469,7 +447,6 @@ package body System.Vax_Float_Operations is
function Lt_F (X, Y : F) return Boolean is
X1, Y1, R : S;
-
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
@@ -484,7 +461,6 @@ package body System.Vax_Float_Operations is
function Lt_G (X, Y : G) return Boolean is
X1, Y1, R : T;
-
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
@@ -499,8 +475,7 @@ package body System.Vax_Float_Operations is
function Mul_F (X, Y : F) return F is
X1, Y1, R : S;
- R1 : F;
-
+ R1 : F;
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
@@ -516,8 +491,7 @@ package body System.Vax_Float_Operations is
function Mul_G (X, Y : G) return G is
X1, Y1, R : T;
- R1 : G;
-
+ R1 : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
@@ -527,14 +501,41 @@ package body System.Vax_Float_Operations is
return R1;
end Mul_G;
+ ----------
+ -- Ne_F --
+ ----------
+
+ function Ne_F (X, Y : F) return Boolean is
+ X1, Y1, R : S;
+ begin
+ Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
+ Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
+ Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
+ (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
+ return R = 0.0;
+ end Ne_F;
+
+ ----------
+ -- Ne_G --
+ ----------
+
+ function Ne_G (X, Y : G) return Boolean is
+ X1, Y1, R : T;
+ begin
+ Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
+ Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
+ Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
+ (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
+ return R = 0.0;
+ end Ne_G;
+
-----------
-- Neg_F --
-----------
function Neg_F (X : F) return F is
A, B : S;
- C : F;
-
+ C : F;
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
Asm ("cpysn %1,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
@@ -548,8 +549,7 @@ package body System.Vax_Float_Operations is
function Neg_G (X : G) return G is
A, B : T;
- C : G;
-
+ C : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Asm ("cpysn %1,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
@@ -590,7 +590,7 @@ package body System.Vax_Float_Operations is
function Sub_F (X, Y : F) return F is
X1, Y1, R : S;
- R1 : F;
+ R1 : F;
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
@@ -607,8 +607,7 @@ package body System.Vax_Float_Operations is
function Sub_G (X, Y : G) return G is
X1, Y1, R : T;
- R1 : G;
-
+ R1 : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
diff --git a/gcc/ada/s-wchcon.ads b/gcc/ada/s-wchcon.ads
index f26664585259..b5fdba04bfd0 100644
--- a/gcc/ada/s-wchcon.ads
+++ b/gcc/ada/s-wchcon.ads
@@ -171,7 +171,7 @@ package System.WCh_Con is
subtype WC_ESC_Encoding_Method is
WC_Encoding_Method range WCEM_Hex .. WCEM_Hex;
- -- Encoding methods using an ESC character at the start of the sequence.
+ -- Encoding methods using an ESC character at the start of the sequence
subtype WC_Upper_Half_Encoding_Method is
WC_Encoding_Method range WCEM_Upper .. WCEM_UTF8;
diff --git a/gcc/ada/sdefault.ads b/gcc/ada/sdefault.ads
index d8e5f06e759c..2a6fd4b1fd53 100644
--- a/gcc/ada/sdefault.ads
+++ b/gcc/ada/sdefault.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1999 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
@@ -24,15 +24,15 @@
-- --
------------------------------------------------------------------------------
-with Types; use Types;
-package Sdefault is
+-- This package contains functions that return the default values for the
+-- include and object file directories, target name, default library
+-- subdirectory (libsubdir) prefix, and the target OS.
- -- This package contains functions that return the default values for
- -- the include and object file directories, target name, and the default
- -- library subdirectory (libsubdir) prefix.
+with Types; use Types;
+package Sdefault is
function Include_Dir_Default_Name return String_Ptr;
- function Object_Dir_Default_Name return String_Ptr;
- function Target_Name return String_Ptr;
- function Search_Dir_Prefix return String_Ptr;
+ function Object_Dir_Default_Name return String_Ptr;
+ function Target_Name return String_Ptr;
+ function Search_Dir_Prefix return String_Ptr;
end Sdefault;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 838e82256e7b..167d088b3e93 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -777,7 +777,7 @@ package body Sem_Ch10 is
declare
Save_Style_Check : constant Boolean := Style_Check;
Save_Warning : constant Warning_Mode_Type := Warning_Mode;
- Options : Style_Check_Options;
+ Options : Style_Check_Options;
begin
Save_Style_Check_Options (Options);
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 5509185db313..31f7d634102c 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -25,14 +25,14 @@
------------------------------------------------------------------------------
-- This package contains various subprograms involved in compile time
--- evaluation of expressions and checks for staticness of expressions
--- and types. It also contains the circuitry for checking for violations
--- of pure and preelaborated conditions (this naturally goes here, since
--- these rules involve consideration of staticness).
+-- evaluation of expressions and checks for staticness of expressions and
+-- types. It also contains the circuitry for checking for violations of pure
+-- and preelaborated conditions (this naturally goes here, since these rules
+-- involve consideration of staticness).
--- Note: the static evaluation for attributes is found in Sem_Attr even
--- though logically it belongs here. We have done this so that it is easier
--- to add new attributes to GNAT.
+-- Note: the static evaluation for attributes is found in Sem_Attr even though
+-- logically it belongs here. We have done this so that it is easier to add
+-- new attributes to GNAT.
with Types; use Types;
with Uintp; use Uintp;
@@ -45,66 +45,64 @@ package Sem_Eval is
------------------------------------
-- This package contains a set of routine that process individual
- -- subexpression nodes with the objective of folding (precomputing)
- -- the value of static expressions that are known at compile time and
- -- properly computing the setting of two flags that appear in every
- -- subexpression node:
+ -- subexpression nodes with the objective of folding (precomputing) the
+ -- value of static expressions that are known at compile time and properly
+ -- computing the setting of two flags that appear in every subexpression
+ -- node:
-- Is_Static_Expression
- -- This flag is set on any expression that is static according
- -- to the rules in (RM 4.9(3-32)).
+ -- This flag is set on any expression that is static according to the
+ -- rules in (RM 4.9(3-32)).
-- Raises_Constraint_Error
-- This flag indicatest that it is known at compile time that the
-- evaluation of an expression raises constraint error. If the
- -- expression is static, and this flag is off, then it is also known
- -- at compile time that the expression does not raise constraint error
+ -- expression is static, and this flag is off, then it is also known at
+ -- compile time that the expression does not raise constraint error
-- (i.e. the flag is accurate for static expressions, and conservative
-- for non-static expressions.
-- If a static expression does not raise constraint error, then the
- -- Raises_Constraint_Error flag is off, and the expression must be
- -- computed at compile time, which means that it has the form of either
- -- a literal, or a constant that is itself (recursively) either a literal
- -- or a constant.
+ -- Raises_Constraint_Error flag is off, and the expression must be computed
+ -- at compile time, which means that it has the form of either a literal,
+ -- or a constant that is itself (recursively) either a literal or a
+ -- constant.
- -- The above rules must be followed exactly in order for legality
- -- checks to be accurate. For subexpressions that are not static
- -- according to the RM definition, they are sometimes folded anyway,
- -- but of course in this case Is_Static_Expression is not set.
+ -- The above rules must be followed exactly in order for legality checks to
+ -- be accurate. For subexpressions that are not static according to the RM
+ -- definition, they are sometimes folded anyway, but of course in this case
+ -- Is_Static_Expression is not set.
-------------------------------
-- Compile-Time Known Values --
-------------------------------
-- For most legality checking purposes the flag Is_Static_Expression
- -- defined in Sinfo should be used. This package also provides
- -- a routine called Is_OK_Static_Expression which in addition of
- -- checking that an expression is static in the RM 4.9 sense, it
- -- checks that the expression does not raise constraint error. In
- -- fact for certain legality checks not only do we need to ascertain
- -- that the expression is static, but we must also ensure that it
- -- does not raise constraint error.
+ -- defined in Sinfo should be used. This package also provides a routine
+ -- called Is_OK_Static_Expression which in addition of checking that an
+ -- expression is static in the RM 4.9 sense, it checks that the expression
+ -- does not raise constraint error. In fact for certain legality checks not
+ -- only do we need to ascertain that the expression is static, but we must
+ -- also ensure that it does not raise constraint error.
--
- -- Neither of Is_Static_Expression and Is_OK_Static_Expression should
- -- be used for compile time evaluation purposes. In fact certain
- -- expression whose value is known at compile time are not static
- -- in the RM 4.9 sense. A typical example is:
+ -- Neither of Is_Static_Expression and Is_OK_Static_Expression should be
+ -- used for compile time evaluation purposes. In fact certain expression
+ -- whose value is known at compile time are not static in the RM 4.9 sense.
+ -- A typical example is:
--
-- C : constant Integer := Record_Type'Size;
--
- -- The expression 'C' is not static in the technical RM sense, but for
- -- many simple record types, the size is in fact known at compile time.
- -- When we are trying to perform compile time constant folding (for
- -- instance for expressions such as 'C + 1', Is_Static_Expression or
- -- Is_OK_Static_Expression are not the right functions to test to see
- -- if folding is possible. Instead, we use Compile_Time_Known_Value.
- -- All static expressions that do not raise constraint error (i.e.
- -- those for which Is_OK_Static_Expression is true) are known at
- -- compile time, but as shown by the above example, there are cases
- -- of non-static expressions which are known at compile time.
+ -- The expression 'C' is not static in the technical RM sense, but for many
+ -- simple record types, the size is in fact known at compile time. When we
+ -- are trying to perform compile time constant folding (for instance for
+ -- expressions like C + 1, Is_Static_Expression or Is_OK_Static_Expression
+ -- are not the right functions to test if folding is possible. Instead, we
+ -- use Compile_Time_Known_Value. All static expressions that do not raise
+ -- constraint error (i.e. those for which Is_OK_Static_Expression is true)
+ -- are known at compile time, but as shown by the above example, there are
+ -- cases of non-static expressions which are known at compile time.
-----------------
-- Subprograms --
@@ -114,17 +112,17 @@ package Sem_Eval is
-- Deals with the special check required for a static expression that
-- appears in a non-static context, i.e. is not part of a larger static
-- expression (see RM 4.9(35)), i.e. the value of the expression must be
- -- within the base range of the base type of its expected type. A check
- -- is also made for expressions that are inside the base range, but
- -- outside the range of the expected subtype (this is a warning message
- -- rather than an illegality).
+ -- within the base range of the base type of its expected type. A check is
+ -- also made for expressions that are inside the base range, but outside
+ -- the range of the expected subtype (this is a warning message rather than
+ -- an illegality).
--
-- Note: most cases of non-static context checks are handled within
- -- Sem_Eval itself, including all cases of expressions at the outer
- -- level (i.e. those that are not a subexpression). Currently the only
- -- outside customer for this procedure is Sem_Attr (because Eval_Attribute
- -- is there). There is also one special case arising from ranges (see body
- -- of Resolve_Range).
+ -- Sem_Eval itself, including all cases of expressions at the outer level
+ -- (i.e. those that are not a subexpression). Currently the only outside
+ -- customer for this procedure is Sem_Attr (because Eval_Attribute is
+ -- there). There is also one special case arising from ranges (see body of
+ -- Resolve_Range).
procedure Check_String_Literal_Length (N : Node_Id; Ttype : Entity_Id);
-- N is either a string literal, or a constraint error node. In the latter
@@ -138,48 +136,47 @@ package Sem_Eval is
function Compile_Time_Compare
(L, R : Node_Id;
Rec : Boolean := False) return Compare_Result;
- -- Given two expression nodes, finds out whether it can be determined
- -- at compile time how the runtime values will compare. An Unknown
- -- result means that the result of a comparison cannot be determined at
- -- compile time, otherwise the returned result indicates the known result
- -- of the comparison, given as tightly as possible (i.e. EQ or LT is a
- -- preferred returned value to LE). Rec is a parameter that is set True
- -- for a recursive call from within Compile_Time_Compare to avoid some
- -- infinite recursion cases. It should never be set by a client.
+ -- Given two expression nodes, finds out whether it can be determined at
+ -- compile time how the runtime values will compare. An Unknown result
+ -- means that the result of a comparison cannot be determined at compile
+ -- time, otherwise the returned result indicates the known result of the
+ -- comparison, given as tightly as possible (i.e. EQ or LT is preferred
+ -- returned value to LE). Rec is a parameter that is set True for a
+ -- recursive call from within Compile_Time_Compare to avoid some infinite
+ -- recursion cases. It should never be set by a client.
procedure Flag_Non_Static_Expr (Msg : String; Expr : Node_Id);
- -- This procedure is called after it has been determined that Expr is
- -- not static when it is required to be. Msg is the text of a message
- -- that explains the error. This procedure checks if an error is already
- -- posted on Expr, if so, it does nothing unless All_Errors_Mode is set
- -- in which case this flag is ignored. Otherwise the given message is
- -- posted using Error_Msg_F, and then Why_Not_Static is called on
- -- Expr to generate additional messages. The string given as Msg
- -- should end with ! to make it an unconditional message, to ensure
- -- that if it is posted, the entire set of messages is all posted.
+ -- This procedure is called after it has been determined that Expr is not
+ -- static when it is required to be. Msg is the text of a message that
+ -- explains the error. This procedure checks if an error is already posted
+ -- on Expr, if so, it does nothing unless All_Errors_Mode is set in which
+ -- case this flag is ignored. Otherwise the given message is posted using
+ -- Error_Msg_F, and then Why_Not_Static is called on Expr to generate
+ -- additional messages. The string given as Msg should end with ! to make
+ -- it an unconditional message, to ensure that if it is posted, the entire
+ -- set of messages is all posted.
function Is_OK_Static_Expression (N : Node_Id) return Boolean;
- -- An OK static expression is one that is static in the RM definition
- -- sense and which does not raise constraint error. For most legality
- -- checking purposes you should use Is_Static_Expression. For those
- -- legality checks where the expression N should not raise constaint
- -- error use this routine. This routine is *not* to be used in contexts
- -- where the test is for compile time evaluation purposes. Use routine
- -- Compile_Time_Known_Value instead (see section on "Compile-Time Known
- -- Values" above).
+ -- An OK static expression is one that is static in the RM definition sense
+ -- and which does not raise constraint error. For most legality checking
+ -- purposes you should use Is_Static_Expression. For those legality checks
+ -- where the expression N should not raise constaint error use this
+ -- routine. This routine is *not* to be used in contexts where the test is
+ -- for compile time evaluation purposes. Use Compile_Time_Known_Value
+ -- instead (see section on "Compile-Time Known Values" above).
function Is_Static_Range (N : Node_Id) return Boolean;
- -- Determine if range is static, as defined in RM 4.9(26). The only
- -- allowed argument is an N_Range node (but note that the semantic
- -- analysis of equivalent range attribute references already turned
- -- them into the equivalent range).
+ -- Determine if range is static, as defined in RM 4.9(26). The only allowed
+ -- argument is an N_Range node (but note that the semantic analysis of
+ -- equivalent range attribute references already turned them into the
+ -- equivalent range).
function Is_OK_Static_Range (N : Node_Id) return Boolean;
- -- Like Is_Static_Range, but also makes sure that the bounds of the
- -- range are compile-time evaluable (i.e. do not raise constraint error).
- -- A result of true means that the bounds are compile time evaluable.
- -- A result of false means they are not (either because the range is
- -- not static, or because one or the other bound raises CE).
+ -- Like Is_Static_Range, but also makes sure that the bounds of the range
+ -- are compile-time evaluable (i.e. do not raise constraint error). A
+ -- result of true means that the bounds are compile time evaluable. A
+ -- result of false means they are not (either because the range is not
+ -- static, or because one or the other bound raises CE).
function Is_Static_Subtype (Typ : Entity_Id) return Boolean;
-- Determines whether a subtype fits the definition of an Ada static
@@ -187,10 +184,10 @@ package Sem_Eval is
function Is_OK_Static_Subtype (Typ : Entity_Id) return Boolean;
-- Like Is_Static_Subtype but also makes sure that the bounds of the
- -- subtype are compile-time evaluable (i.e. do not raise constraint
- -- error). A result of true means that the bounds are compile time
- -- evaluable. A result of false means they are not (either because the
- -- range is not static, or because one or the other bound raises CE).
+ -- subtype are compile-time evaluable (i.e. do not raise constraint error).
+ -- A result of true means that the bounds are compile time evaluable. A
+ -- result of false means they are not (either because the range is not
+ -- static, or because one or the other bound raises CE).
function Subtypes_Statically_Compatible
(T1 : Entity_Id;
@@ -204,52 +201,49 @@ package Sem_Eval is
-- are statically matching subtypes (RM 4.9.1(1-2)).
function Compile_Time_Known_Value (Op : Node_Id) return Boolean;
- -- Returns true if Op is an expression not raising constraint error
- -- whose value is known at compile time. This is true if Op is a static
- -- expression, but can also be true for expressions which are
- -- technically non-static but which are in fact known at compile time,
- -- such as the static lower bound of a non-static range or the value
- -- of a constant object whose initial value is static. Note that this
- -- routine is defended against unanalyzed expressions. Such expressions
- -- will not cause a blowup, they may cause pessimistic (i.e. False)
- -- results to be returned.
+ -- Returns true if Op is an expression not raising constraint error whose
+ -- value is known at compile time. This is true if Op is a static
+ -- expression, but can also be true for expressions which are technically
+ -- non-static but which are in fact known at compile time, such as the
+ -- static lower bound of a non-static range or the value of a constant
+ -- object whose initial value is static. Note that this routine is defended
+ -- against unanalyzed expressions. Such expressions will not cause a
+ -- blowup, they may cause pessimistic (i.e. False) results to be returned.
function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean;
- -- Similar to Compile_Time_Known_Value, but also returns True if the
- -- value is a compile time known aggregate, i.e. an aggregate all of
- -- whose constituent expressions are either compile time known values
- -- or compile time known aggregates.
+ -- Similar to Compile_Time_Known_Value, but also returns True if the value
+ -- is a compile time known aggregate, i.e. an aggregate all of whose
+ -- constituent expressions are either compile time known values or compile
+ -- time known aggregates.
function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
- -- If T is an array whose index bounds are all known at compile time,
- -- then True is returned, if T is not an array, or one or more of its
- -- index bounds is not known at compile time, then False is returned.
+ -- If T is an array whose index bounds are all known at compile time, then
+ -- True is returned, if T is not an array, or one or more of its index
+ -- bounds is not known at compile time, then False is returned.
function Expr_Value (N : Node_Id) return Uint;
- -- Returns the folded value of the expression N. This function is called
- -- in instances where it has already been determined that the expression
- -- is static or its value is known at compile time (ie the call to
- -- Compile_Time_Known_Value (N) returns True). This version is used for
- -- integer values, and enumeration or character literals. In the latter
- -- two cases, the value returned is the Pos value in the relevant
- -- enumeration type. It can also be used for fixed-point values, in
- -- which case it returns the corresponding integer value. It cannot be
- -- used for floating-point values.
+ -- Returns the folded value of the expression N. This function is called in
+ -- instances where it has already been determined that the expression is
+ -- static or its value is compile time known (Compile_Time_Known_Value (N)
+ -- returns True). This version is used for integer values, and enumeration
+ -- or character literals. In the latter two cases, the value returned is
+ -- the Pos value in the relevant enumeration type. It can also be used for
+ -- fixed-point values, in which case it returns the corresponding integer
+ -- value. It cannot be used for floating-point values.
function Expr_Value_E (N : Node_Id) return Entity_Id;
- -- Returns the folded value of the expression. This function is called
- -- in instances where it has already been determined that the expression
- -- is static or its value known at compile time. This version is used
- -- for enumeration types and returns the corresponding enumeration
- -- literal.
+ -- Returns the folded value of the expression. This function is called in
+ -- instances where it has already been determined that the expression is
+ -- static or its value known at compile time. This version is used for
+ -- enumeration types and returns the corresponding enumeration literal.
function Expr_Value_R (N : Node_Id) return Ureal;
- -- Returns the folded value of the expression. This function is called
- -- in instances where it has already been determined that the expression
- -- is static or its value known at compile time. This version is used
- -- for real values (including both the floating-point and fixed-point
- -- cases). In the case of a fixed-point type, the real value is returned
- -- (cf above version returning Uint).
+ -- Returns the folded value of the expression. This function is called in
+ -- instances where it has already been determined that the expression is
+ -- static or its value known at compile time. This version is used for real
+ -- values (including both the floating-point and fixed-point cases). In the
+ -- case of a fixed-point type, the real value is returned (cf above version
+ -- returning Uint).
function Expr_Value_S (N : Node_Id) return Node_Id;
-- Returns the folded value of the expression. This function is called
@@ -261,12 +255,12 @@ package Sem_Eval is
-- This is identical to Expr_Value, except in the case of enumeration
-- literals of types for which an enumeration representation clause has
-- been given, in which case it returns the representation value rather
- -- than the pos value. This is the value that is needed for generating
- -- code sequences, while the Expr_Value value is appropriate for compile
- -- time constraint errors or getting the logical value. Note that this
- -- function does NOT concern itself with biased values, if the caller
- -- needs a properly biased value, the subtraction of the bias must be
- -- handled explicitly.
+ -- than the pos value. This is the value that is needed for generating code
+ -- sequences, while the Expr_Value value is appropriate for compile time
+ -- constraint errors or getting the logical value. Note that this function
+ -- does NOT concern itself with biased values, if the caller needs a
+ -- properly biased value, the subtraction of the bias must be handled
+ -- explicitly.
procedure Eval_Actual (N : Node_Id);
procedure Eval_Allocator (N : Node_Id);
@@ -296,58 +290,56 @@ package Sem_Eval is
procedure Eval_Unchecked_Conversion (N : Node_Id);
procedure Fold_Str (N : Node_Id; Val : String_Id; Static : Boolean);
- -- Rewrite N with a new N_String_Literal node as the result of the
- -- compile time evaluation of the node N. Val is the resulting string
- -- value from the folding operation. The Is_Static_Expression flag is
- -- set in the result node. The result is fully analyzed and resolved.
- -- Static indicates whether the result should be considered static or
- -- not (True = consider static). The point here is that normally all
- -- string literals are static, but if this was the result of some
- -- sequence of evaluation where values were known at compile time
- -- but not static, then the result is not static.
+ -- Rewrite N with a new N_String_Literal node as the result of the compile
+ -- time evaluation of the node N. Val is the resulting string value from
+ -- the folding operation. The Is_Static_Expression flag is set in the
+ -- result node. The result is fully analyzed and resolved. Static indicates
+ -- whether the result should be considered static or not (True = consider
+ -- static). The point here is that normally all string literals are static,
+ -- but if this was the result of some sequence of evaluation where values
+ -- were known at compile time but not static, then the result is not
+ -- static.
procedure Fold_Uint (N : Node_Id; Val : Uint; Static : Boolean);
-- Rewrite N with a (N_Integer_Literal, N_Identifier, N_Character_Literal)
- -- node as the result of the compile time evaluation of the node N. Val
- -- is the result in the integer case and is the position of the literal
- -- in the literals list for the enumeration case. Is_Static_Expression
- -- is set True in the result node. The result is fully analyzed/resolved.
- -- Static indicates whether the result should be considered static or
- -- not (True = consider static). The point here is that normally all
- -- string literals are static, but if this was the result of some
- -- sequence of evaluation where values were known at compile time
- -- but not static, then the result is not static.
+ -- node as the result of the compile time evaluation of the node N. Val is
+ -- the result in the integer case and is the position of the literal in the
+ -- literals list for the enumeration case. Is_Static_Expression is set True
+ -- in the result node. The result is fully analyzed/resolved. Static
+ -- indicates whether the result should be considered static or not (True =
+ -- consider static). The point here is that normally all string literals
+ -- are static, but if this was the result of some sequence of evaluation
+ -- where values were known at compile time but not static, then the result
+ -- is not static.
procedure Fold_Ureal (N : Node_Id; Val : Ureal; Static : Boolean);
-- Rewrite N with a new N_Real_Literal node as the result of the compile
- -- time evaluation of the node N. Val is the resulting real value from
- -- the folding operation. The Is_Static_Expression flag is set in the
- -- result node. The result is fully analyzed and result. Static
- -- indicates whether the result should be considered static or not
- -- (True = consider static). The point here is that normally all
- -- string literals are static, but if this was the result of some
- -- sequence of evaluation where values were known at compile time
- -- but not static, then the result is not static.
+ -- time evaluation of the node N. Val is the resulting real value from the
+ -- folding operation. The Is_Static_Expression flag is set in the result
+ -- node. The result is fully analyzed and result. Static indicates whether
+ -- the result should be considered static or not (True = consider static).
+ -- The point here is that normally all string literals are static, but if
+ -- this was the result of some sequence of evaluation where values were
+ -- known at compile time but not static, then the result is not static.
function Is_In_Range
(N : Node_Id;
Typ : Entity_Id;
Fixed_Int : Boolean := False;
Int_Real : Boolean := False) return Boolean;
- -- Returns True if it can be guaranteed at compile time that expression
- -- N is known to be in range of the subtype Typ. If the values of N or
- -- of either bouds of Type are unknown at compile time, False will
- -- always be returned. A result of False does not mean that the
- -- expression is out of range, merely that it cannot be determined at
- -- compile time that it is in range. If Typ is a floating point type or
- -- Int_Real is set, any integer value is treated as though it was a real
- -- value (i.e. the underlying real value is used). In this case we use
- -- the corresponding real value, both for the bounds of Typ, and for the
- -- value of the expression N. If Typ is a fixed type or a discrete type
- -- and Int_Real is False but flag Fixed_Int is True then any fixed-point
- -- value is treated as though it was a discrete value (i.e. the
- -- underlying integer value is used). In this case we use the
- -- corresponding integer value, both for the bounds of Typ, and for the
+ -- Returns True if it can be guaranteed at compile time that expression is
+ -- known to be in range of the subtype Typ. If the values of N or of either
+ -- bouds of Type are unknown at compile time, False will always be
+ -- returned. A result of False does not mean that the expression is out of
+ -- range, merely that it cannot be determined at compile time that it is in
+ -- range. If Typ is a floating point type or Int_Real is set, any integer
+ -- value is treated as though it was a real value (i.e. the underlying real
+ -- value is used). In this case we use the corresponding real value, both
+ -- for the bounds of Typ, and for the value of the expression N. If Typ is
+ -- a fixed type or a discrete type and Int_Real is False but flag Fixed_Int
+ -- is True then any fixed-point value is treated as though it was discrete
+ -- value (i.e. the underlying integer value is used). In this case we use
+ -- the corresponding integer value, both for the bounds of Typ, and for the
-- value of the expression N. If Typ is a discret type and Fixed_Int as
-- well as Int_Real are false, intere values are used throughout.
@@ -356,52 +348,52 @@ package Sem_Eval is
Typ : Entity_Id;
Fixed_Int : Boolean := False;
Int_Real : Boolean := False) return Boolean;
- -- Returns True if it can be guaranteed at compile time that expression
- -- N is known to be out of range of the subtype Typ. True is returned
- -- if Typ is a scalar type, at least one of whose bounds is known at
- -- compile time, and N is a compile time known expression which can be
- -- determined to be outside a compile_time known bound of Typ. A result
- -- of False does not mean that the expression is in range, merely that
- -- it cannot be determined at compile time that it is out of range. Flags
- -- Int_Real and Fixed_Int are used as in routine Is_In_Range above.
+ -- Returns True if it can be guaranteed at compile time that expression is
+ -- known to be out of range of the subtype Typ. True is returned if Typ is
+ -- a scalar type, at least one of whose bounds is known at compile time,
+ -- and N is a compile time known expression which can be determined to be
+ -- outside a compile_time known bound of Typ. A result of False does not
+ -- mean that the expression is in range, but rather merely that it cannot
+ -- be determined at compile time that it is out of range. Flags Int_Real
+ -- and Fixed_Int are used as in routine Is_In_Range above.
function In_Subrange_Of
(T1 : Entity_Id;
T2 : Entity_Id;
Fixed_Int : Boolean := False) return Boolean;
- -- Returns True if it can be guaranteed at compile time that the range
- -- of values for scalar type T1 are always in the range of scalar type
- -- T2. A result of False does not mean that T1 is not in T2's subrange,
- -- only that it cannot be determined at compile time. Flag Fixed_Int is
- -- used as in routine Is_In_Range above.
+ -- Returns True if it can be guaranteed at compile time that the range of
+ -- values for scalar type T1 are always in the range of scalar type T2. A
+ -- result of False does not mean that T1 is not in T2's subrange, only that
+ -- it cannot be determined at compile time. Flag Fixed_Int is used as in
+ -- routine Is_In_Range above.
function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
- -- Returns True if it can guarantee that Lo .. Hi is a null range.
- -- If it cannot (because the value of Lo or Hi is not known at compile
- -- time) then it returns False.
+ -- Returns True if it can guarantee that Lo .. Hi is a null range. If it
+ -- cannot (because the value of Lo or Hi is not known at compile time) then
+ -- it returns False.
function Not_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
- -- Returns True if it can guarantee that Lo .. Hi is not a null range.
- -- If it cannot (because the value of Lo or Hi is not known at compile
- -- time) then it returns False.
+ -- Returns True if it can guarantee that Lo .. Hi is not a null range. If
+ -- it cannot (because the value of Lo or Hi is not known at compile time)
+ -- then it returns False.
procedure Why_Not_Static (Expr : Node_Id);
-- This procedure may be called after generating an error message that
- -- complains that something is non-static. If it finds good reasons,
- -- it generates one or more error messages pointing the appropriate
- -- offending component of the expression. If no good reasons can be
- -- figured out, then no messages are generated. The expectation here
- -- is that the caller has already issued a message complaining that
- -- the expression is non-static. Note that this message should be
- -- placed using Error_Msg_F or Error_Msg_FE, so that it will sort
- -- before any messages placed by this call. Note that it is fine to
- -- call Why_Not_Static with something that is not an expression, and
- -- usually this has no effect, but in some cases (N_Parameter_Association
- -- or N_Range), it makes sense for the internal recursive calls.
+ -- complains that something is non-static. If it finds good reasons, it
+ -- generates one or more error messages pointing the appropriate offending
+ -- component of the expression. If no good reasons can be figured out, then
+ -- no messages are generated. The expectation here is that the caller has
+ -- already issued a message complaining that the expression is non-static.
+ -- Note that this message should be placed using Error_Msg_F or
+ -- Error_Msg_FE, so that it will sort before any messages placed by this
+ -- call. Note that it is fine to call Why_Not_Static with something that is
+ -- not an expression, and usually this has no effect, but in some cases
+ -- (N_Parameter_Association or N_Range), it makes sense for the internal
+ -- recursive calls.
procedure Initialize;
- -- Initializes the internal data structures. Must be called before
- -- each separate main program unit (e.g. in a GNSA/ASIS context).
+ -- Initializes the internal data structures. Must be called before each
+ -- separate main program unit (e.g. in a GNSA/ASIS context).
private
-- The Eval routines are all marked inline, since they are called once
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index f029dbfb0599..0b499af270c8 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -3094,9 +3094,10 @@ remove_conversions (tree exp, bool true_address)
if (true_address
&& TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE
&& TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (exp)))
- return remove_conversions (VEC_index (constructor_elt,
- CONSTRUCTOR_ELTS (exp), 0)->value,
- true);
+ return
+ remove_conversions (VEC_index (constructor_elt,
+ CONSTRUCTOR_ELTS (exp), 0)->value,
+ true);
break;
case COMPONENT_REF:
--
GitLab