diff options
45 files changed, 463 insertions, 470 deletions
diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 6c0ad94..664e654 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 2e1f38f..e1da11b 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 b11a23e..eb0d5a6 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 f2f0055..679a986 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 ea04477..8268756 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 ed08fc9..d331fbd 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 fd30de8..758c506 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 f474d69..34ef56d 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 e473f57..80c2bfb 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 48658af..55f4d3a 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 e534f65..f5c4253 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 9e34a96..1266280 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 af32798..a7a30b2 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 84c0e22..226661f 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 d959bb5..5ea063a 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 21cbf84..f837224 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 45fa1ae..ac5a654 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 844e2f0..9dfa2c6 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 1fd9049..97ac453 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 44cd6bf..5698461 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 7296291..ecab5bb 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 8b8004f..7847a15 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 1705e1e..bdd0c59c 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 38e5cda..2f0cdf0 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 f9f86d5..4b65da2 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 e4dcffc..453a35b 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 b5e8c67..53d6285 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 59f07bd..f5dbdb9 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 736dd0d..b24b4d8 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 79029e3..479a51e 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 92e7436..248c5fc 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 81b91e9..cd85558 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 477eec3d..b592516 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 a5d476c..e02ebb0 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 e906ff2..159ccc3 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 df92d0d..ceccbc0 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 f5c4d25..aba233d 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 2e8f5c2..c96396d 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 2224ff0..e5f33b1 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 5ab772d..92e6273 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 f266645..b5fdba0 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 d8e5f06..2a6fd4b 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 838e822..167d088 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 5509185..31f7d63 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 f029dbf..0b499af 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: |