diff options
Diffstat (limited to 'gcc/ada')
45 files changed, 145 insertions, 766 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a9856c8..4e5bbb5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2014-08-01 Robert Dewar <dewar@adacore.com> + + * a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads, + a-numaux-darwin.adb, a-numaux-darwin.ads, a-numaux.ads, + a-numaux-libc-x86.ads: Fix bad package header comments. + * elists.ads, elists.adb (Append_New_Elmt): New procedure. + * gnat_rm.texi, a-calend.adb, gnatcmd.adb, einfo.adb, einfo.ads, + checks.adb, sem_prag.adb, sem_prag.ads, rtsfind.ads, freeze.adb, + sem_util.adb, sem_attr.adb, exp_dbug.adb, exp_dbug.ads, gnat1drv.adb, + targparm.adb, targparm.ads, exp_ch6.adb, switch-b.adb, s-shasto.ads, + stand.ads, s-auxdec.ads, opt.adb, opt.ads, mlib-tgt.ads, s-fatgen.adb, + s-fatgen.ads, system.ads, snames.ads-tmpl, s-stalib.ads, + s-os_lib.adb: Remove VMS-specific code. + 2014-08-01 Arnaud Charlet <charlet@adacore.com> * exp_attr.adb (Is_Inline_Floating_Point_Attribute): Revert to diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index 0043a91..7c582ad 100644 --- a/gcc/ada/a-calend.adb +++ b/gcc/ada/a-calend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -69,7 +69,7 @@ package body Ada.Calendar is -- by Integer in various routines. One ramification of this model is that -- the caller site must perform validity checks on returned results. -- The end result of this model is the lack of target specific files per - -- child of Ada.Calendar (a-calfor, a-calfor-vms, a-calfor-vxwors, etc). + -- child of Ada.Calendar (e.g. a-calfor). ----------------------- -- Local Subprograms -- diff --git a/gcc/ada/a-numaux-darwin.adb b/gcc/ada/a-numaux-darwin.adb index 1444603..2e9ffd9 100644 --- a/gcc/ada/a-numaux-darwin.adb +++ b/gcc/ada/a-numaux-darwin.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Apple OS X Version) -- -- -- --- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,8 +30,6 @@ -- -- ------------------------------------------------------------------------------ --- File a-numaux.adb <- a-numaux-darwin.adb - package body Ada.Numerics.Aux is ----------------------- diff --git a/gcc/ada/a-numaux-darwin.ads b/gcc/ada/a-numaux-darwin.ads index 2f58ed8..011ae59 100644 --- a/gcc/ada/a-numaux-darwin.ads +++ b/gcc/ada/a-numaux-darwin.ads @@ -30,12 +30,9 @@ -- -- ------------------------------------------------------------------------------ --- This version is for use with normal Unix math functions, except for --- sine/cosine which have been implemented directly in Ada to get the required --- accuracy in OS X. Alternative packages are used on VxWorks (no need for the --- -lm Linker_Options), and on the x86 (where we have two versions one using --- inline ASM, and one importing from the C long routines that take 80-bit --- arguments). +-- This version is for use on OS X. It uses the normal Unix math functions, +-- except for sine/cosine which have been implemented directly in Ada to get +-- the required accuracy. package Ada.Numerics.Aux is pragma Pure; diff --git a/gcc/ada/a-numaux-libc-x86.ads b/gcc/ada/a-numaux-libc-x86.ads index 3261c11..3b793c6 100644 --- a/gcc/ada/a-numaux-libc-x86.ads +++ b/gcc/ada/a-numaux-libc-x86.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (C Library Version for x86) -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,16 +30,7 @@ -- -- ------------------------------------------------------------------------------ --- This package provides the basic computational interface for the generic --- elementary functions. The C library version interfaces with the routines --- in the C mathematical library, and is thus quite portable, although it may --- not necessarily meet the requirements for accuracy in the numerics annex. --- One advantage of using this package is that it will interface directly to --- hardware instructions, such as the those provided on the Intel x86. - --- Note: there are two versions of this package. One using the 80-bit x86 --- long double format (which is this version), and one using 64-bit IEEE --- double (see file a-numaux.ads). +-- This version is for the x86 using the 80-bit x86 long double format package Ada.Numerics.Aux is pragma Pure; diff --git a/gcc/ada/a-numaux-vxworks.ads b/gcc/ada/a-numaux-vxworks.ads index ce567ad..5fdf778 100644 --- a/gcc/ada/a-numaux-vxworks.ads +++ b/gcc/ada/a-numaux-vxworks.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (C Library Version, VxWorks) -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,23 +30,12 @@ -- -- ------------------------------------------------------------------------------ --- This package provides the basic computational interface for the generic --- elementary functions. The C library version interfaces with the routines --- in the C mathematical library, and is thus quite portable, although it may --- not necessarily meet the requirements for accuracy in the numerics annex. --- One advantage of using this package is that it will interface directly to --- hardware instructions, such as the those provided on the Intel x86. - --- Note: there are two versions of this package. One using the normal IEEE --- 64-bit double format (which is this version), and one using 80-bit x86 --- long double (see file 4onumaux.ads). +-- Version for use on VxWorks (where we have no libm.a library), so the pragma +-- Linker_Options ("-lm") is omitted in this version. package Ada.Numerics.Aux is pragma Pure; - -- This version omits the pragma linker_options ("-lm") since there is - -- no libm.a library for VxWorks. - type Double is digits 15; -- Type Double is the type used to call the C routines diff --git a/gcc/ada/a-numaux-x86.adb b/gcc/ada/a-numaux-x86.adb index 811485d..5f245a2 100644 --- a/gcc/ada/a-numaux-x86.adb +++ b/gcc/ada/a-numaux-x86.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Machine Version for x86) -- -- -- --- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,11 +30,6 @@ -- -- ------------------------------------------------------------------------------ --- File a-numaux.adb <- 86numaux.adb - --- This version of Numerics.Aux is for the IEEE Double Extended floating --- point format on x86. - with System.Machine_Code; use System.Machine_Code; package body Ada.Numerics.Aux is diff --git a/gcc/ada/a-numaux-x86.ads b/gcc/ada/a-numaux-x86.ads index 7211fbb..bf8b49c 100644 --- a/gcc/ada/a-numaux-x86.ads +++ b/gcc/ada/a-numaux-x86.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (Machine Version for x86) -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,14 +30,7 @@ -- -- ------------------------------------------------------------------------------ --- This package provides the basic computational interface for the generic --- elementary functions. This implementation is based on the glibc assembly --- sources for the x86 glibc math library. - --- Note: there are two versions of this package. One using the 80-bit x86 --- long double format (which is this version), and one using 64-bit IEEE --- double (see file a-numaux.ads). The latter version imports the C --- routines directly. +-- Version for the x86, using 64-bit IEEE format with inline asm statements package Ada.Numerics.Aux is pragma Pure; diff --git a/gcc/ada/a-numaux.ads b/gcc/ada/a-numaux.ads index 7f265dd..f69fdc1 100644 --- a/gcc/ada/a-numaux.ads +++ b/gcc/ada/a-numaux.ads @@ -38,9 +38,12 @@ -- hardware instructions, such as the those provided on the Intel x86. -- This version here is for use with normal Unix math functions. Alternative --- packages are used VxWorks (no need for the -lm Linker_Options), and on the --- x86 (where we have two versions one using inline ASM, and one importing --- from the C long routines that take 80-bit arguments). +-- versions are provided for special situations: + +-- a-numaux-darwin For OS/X (special handling of sin/cos for accuracy) +-- a-numaux-libc-x86 For the x86, using 80-bit long double format +-- a-numaux-x86 For the x86, using 64-bit IEEE (inline asm statements) +-- a-numaux-vxworks For use on VxWorks (where we have no libm.a library) package Ada.Numerics.Aux is pragma Pure; diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index facf85b..bf27d4e 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -8524,14 +8524,7 @@ package body Checks is function Range_Checks_Suppressed (E : Entity_Id) return Boolean is begin if Present (E) then - - -- Note: for now we always suppress range checks on Vax float types, - -- since Gigi does not know how to generate these checks. - - if Vax_Float (E) then - return True; - - elsif Kill_Range_Checks (E) then + if Kill_Range_Checks (E) then return True; elsif Checks_May_Be_Suppressed (E) then @@ -8576,9 +8569,7 @@ package body Checks is declare Typ : constant Entity_Id := Etype (Expr); begin - if Vax_Float (Typ) then - return True; - elsif Checks_May_Be_Suppressed (Typ) + if Checks_May_Be_Suppressed (Typ) and then (Is_Check_Suppressed (Typ, Range_Check) or else Is_Check_Suppressed (Typ, Validity_Check)) diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 038fe39..7e0eaaa 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -115,7 +115,6 @@ package body Einfo is -- RM_Size Uint13 -- Alignment Uint14 - -- First_Optional_Parameter Node14 -- Normalized_Position Uint14 -- Shadow_Entities List14 @@ -1266,12 +1265,6 @@ package body Einfo is return Node17 (Id); end First_Literal; - function First_Optional_Parameter (Id : E) return E is - begin - pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); - return Node14 (Id); - end First_Optional_Parameter; - function First_Private_Entity (Id : E) return E is begin pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package) @@ -4004,12 +3997,6 @@ package body Einfo is Set_Node17 (Id, V); end Set_First_Literal; - procedure Set_First_Optional_Parameter (Id : E; V : E) is - begin - pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); - Set_Node14 (Id, V); - end Set_First_Optional_Parameter; - procedure Set_First_Private_Entity (Id : E; V : E) is begin pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package) @@ -8178,18 +8165,6 @@ package body Einfo is end if; end Underlying_Type; - --------------- - -- Vax_Float -- - --------------- - - -- To be removed ??? - - function Vax_Float (Id : E) return B is - pragma Unreferenced (Id); - begin - return False; - end Vax_Float; - ------------------------ -- Write_Entity_Flags -- ------------------------ @@ -8891,10 +8866,6 @@ package body Einfo is E_Loop_Parameter => Write_Str ("Alignment"); - when E_Function | - E_Procedure => - Write_Str ("First_Optional_Parameter"); - when E_Component | E_Discriminant => Write_Str ("Normalized_Position"); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 4cda044..11f6122 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1278,13 +1278,6 @@ package Einfo is -- Note that this field is set in enumeration subtypes, but it still -- points to the first literal of the base type in this case. --- First_Optional_Parameter (Node14) --- Defined in (non-generic) function and procedure entities. Set to a --- non-null value only if a pragma Import_Function, Import_Procedure --- or Import_Valued_Procedure specifies a First_Optional_Parameter --- argument, in which case this field points to the parameter entity --- corresponding to the specified parameter. - -- First_Private_Entity (Node16) -- Defined in all entities containing private parts (packages, protected -- types and subtypes, task types and subtypes). The entities on the @@ -5615,7 +5608,6 @@ package Einfo is -- Safe_Last_Value (synth) -- Type_Low_Bound (synth) -- Type_High_Bound (synth) - -- Vax_Float (synth) -- (plus type attributes) -- E_Function @@ -5626,7 +5618,6 @@ package Einfo is -- Protected_Body_Subprogram (Node11) -- Next_Inlined_Subprogram (Node12) -- Elaboration_Entity (Node13) (not implicit /=) - -- First_Optional_Parameter (Node14) (non-generic case only) -- DT_Position (Uint15) -- DTC_Entity (Node16) -- First_Entity (Node17) @@ -5926,7 +5917,6 @@ package Einfo is -- Protected_Body_Subprogram (Node11) -- Next_Inlined_Subprogram (Node12) -- Elaboration_Entity (Node13) - -- First_Optional_Parameter (Node14) (non-generic case only) -- DT_Position (Uint15) -- DTC_Entity (Node16) -- First_Entity (Node17) @@ -6537,7 +6527,6 @@ package Einfo is function First_Exit_Statement (Id : E) return N; function First_Index (Id : E) return N; function First_Literal (Id : E) return E; - function First_Optional_Parameter (Id : E) return E; function First_Private_Entity (Id : E) return E; function First_Rep_Item (Id : E) return N; function Float_Rep (Id : E) return F; @@ -6866,7 +6855,6 @@ package Einfo is function Used_As_Generic_Actual (Id : E) return B; function Uses_Lock_Free (Id : E) return B; function Uses_Sec_Stack (Id : E) return B; - function Vax_Float (Id : E) return B; function Warnings_Off (Id : E) return B; function Warnings_Off_Used (Id : E) return B; function Warnings_Off_Used_Unmodified (Id : E) return B; @@ -7172,7 +7160,6 @@ package Einfo is procedure Set_First_Exit_Statement (Id : E; V : N); procedure Set_First_Index (Id : E; V : N); procedure Set_First_Literal (Id : E; V : E); - procedure Set_First_Optional_Parameter (Id : E; V : E); procedure Set_First_Private_Entity (Id : E; V : E); procedure Set_First_Rep_Item (Id : E; V : N); procedure Set_Float_Rep (Id : E; V : F); @@ -7921,7 +7908,6 @@ package Einfo is pragma Inline (First_Exit_Statement); pragma Inline (First_Index); pragma Inline (First_Literal); - pragma Inline (First_Optional_Parameter); pragma Inline (First_Private_Entity); pragma Inline (First_Rep_Item); pragma Inline (Freeze_Node); @@ -8402,7 +8388,6 @@ package Einfo is pragma Inline (Set_First_Exit_Statement); pragma Inline (Set_First_Index); pragma Inline (Set_First_Literal); - pragma Inline (Set_First_Optional_Parameter); pragma Inline (Set_First_Private_Entity); pragma Inline (Set_First_Rep_Item); pragma Inline (Set_Freeze_Node); diff --git a/gcc/ada/elists.adb b/gcc/ada/elists.adb index 7e62ce4..fbfb9e7 100644 --- a/gcc/ada/elists.adb +++ b/gcc/ada/elists.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -138,6 +138,19 @@ package body Elists is end if; end Append_Elmt; + --------------------- + -- Append_New_Elmt -- + --------------------- + + procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id) is + begin + if To = No_Elist then + To := New_Elmt_List; + end if; + + Append_Elmt (N, To); + end Append_New_Elmt; + ------------------------ -- Append_Unique_Elmt -- ------------------------ diff --git a/gcc/ada/elists.ads b/gcc/ada/elists.ads index f033136..3353b9c 100644 --- a/gcc/ada/elists.ads +++ b/gcc/ada/elists.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -126,6 +126,11 @@ package Elists is -- Appends N at the end of To, allocating a new element. N must be a -- non-empty node or entity Id, and To must be an Elist (not No_Elist). + procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id); + pragma Inline (Append_New_Elmt); + -- Like Append_Elmt if Elist_Id is not No_List, but if Elist_Id is No_List, + -- then first assigns it an empty element list and then does the append. + procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id); -- Like Append_Elmt, except that a check is made to see if To already -- contains N and if so the call has no effect. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4550986..50bc11a 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1976,7 +1976,6 @@ package body Exp_Ch6 is -- Rewrite call to predefined operator as operator -- Replace actuals to in-out parameters that are numeric conversions, -- with explicit assignment to temporaries before and after the call. - -- Remove optional actuals if First_Optional_Parameter specified. -- Note that the list of actuals has been filled with default expressions -- during semantic analysis of the call. Only the extra actuals required @@ -4022,150 +4021,6 @@ package body Exp_Ch6 is Establish_Transient_Scope (Call_Node, Sec_Stack => True); end if; end if; - - -- Test for First_Optional_Parameter, and if so, truncate parameter list - -- if there are optional parameters at the trailing end. - -- Note: we never delete procedures for call via a pointer. - - if (Ekind (Subp) = E_Procedure or else Ekind (Subp) = E_Function) - and then Present (First_Optional_Parameter (Subp)) - then - declare - Last_Keep_Arg : Node_Id; - - begin - -- Last_Keep_Arg will hold the last actual that should be kept. - -- If it remains empty at the end, it means that all parameters - -- are optional. - - Last_Keep_Arg := Empty; - - -- Find first optional parameter, must be present since we checked - -- the validity of the parameter before setting it. - - Formal := First_Formal (Subp); - Actual := First_Actual (Call_Node); - while Formal /= First_Optional_Parameter (Subp) loop - Last_Keep_Arg := Actual; - Next_Formal (Formal); - Next_Actual (Actual); - end loop; - - -- We have Formal and Actual pointing to the first potentially - -- droppable argument. We can drop all the trailing arguments - -- whose actual matches the default. Note that we know that all - -- remaining formals have defaults, because we checked that this - -- requirement was met before setting First_Optional_Parameter. - - -- We use Fully_Conformant_Expressions to check for identity - -- between formals and actuals, which may miss some cases, but - -- on the other hand, this is only an optimization (if we fail - -- to truncate a parameter it does not affect functionality). - -- So if the default is 3 and the actual is 1+2, we consider - -- them unequal, which hardly seems worrisome. - - while Present (Formal) loop - if not Fully_Conformant_Expressions - (Actual, Default_Value (Formal)) - then - Last_Keep_Arg := Actual; - end if; - - Next_Formal (Formal); - Next_Actual (Actual); - end loop; - - -- If no arguments, delete entire list, this is the easy case - - if No (Last_Keep_Arg) then - Set_Parameter_Associations (Call_Node, No_List); - Set_First_Named_Actual (Call_Node, Empty); - - -- Case where at the last retained argument is positional. This - -- is also an easy case, since the retained arguments are already - -- in the right form, and we don't need to worry about the order - -- of arguments that get eliminated. - - elsif Is_List_Member (Last_Keep_Arg) then - while Present (Next (Last_Keep_Arg)) loop - Discard_Node (Remove_Next (Last_Keep_Arg)); - end loop; - - Set_First_Named_Actual (Call_Node, Empty); - - -- This is the annoying case where the last retained argument - -- is a named parameter. Since the original arguments are not - -- in declaration order, we may have to delete some fairly - -- random collection of arguments. - - else - declare - Temp : Node_Id; - Passoc : Node_Id; - - begin - -- First step, remove all the named parameters from the - -- list (they are still chained using First_Named_Actual - -- and Next_Named_Actual, so we have not lost them). - - Temp := First (Parameter_Associations (Call_Node)); - - -- Case of all parameters named, remove them all - - if Nkind (Temp) = N_Parameter_Association then - -- Suppress warnings to avoid warning on possible - -- infinite loop (because Call_Node is not modified). - - pragma Warnings (Off); - while Is_Non_Empty_List - (Parameter_Associations (Call_Node)) - loop - Temp := - Remove_Head (Parameter_Associations (Call_Node)); - end loop; - pragma Warnings (On); - - -- Case of mixed positional/named, remove named parameters - - else - while Nkind (Next (Temp)) /= N_Parameter_Association loop - Next (Temp); - end loop; - - while Present (Next (Temp)) loop - Remove (Next (Temp)); - end loop; - end if; - - -- Now we loop through the named parameters, till we get - -- to the last one to be retained, adding them to the list. - -- Note that the Next_Named_Actual list does not need to be - -- touched since we are only reordering them on the actual - -- parameter association list. - - Passoc := Parent (First_Named_Actual (Call_Node)); - loop - Temp := Relocate_Node (Passoc); - Append_To - (Parameter_Associations (Call_Node), Temp); - exit when - Last_Keep_Arg = Explicit_Actual_Parameter (Passoc); - Passoc := Parent (Next_Named_Actual (Passoc)); - end loop; - - Set_Next_Named_Actual (Temp, Empty); - - loop - Temp := Next_Named_Actual (Passoc); - exit when No (Temp); - Set_Next_Named_Actual - (Passoc, Next_Named_Actual (Parent (Temp))); - end loop; - end; - - end if; - end; - end if; end Expand_Call; ------------------------------- diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index d1439ab..c025f05 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -604,20 +604,6 @@ package body Exp_Dbug is Add_Real_To_Buffer (Small_Value (E)); end if; - -- Vax floating-point case - - elsif Vax_Float (E) then - if Digits_Value (Base_Type (E)) = 6 then - Get_External_Name (E, True, "XFF"); - - elsif Digits_Value (Base_Type (E)) = 9 then - Get_External_Name (E, True, "XFF"); - - else - pragma Assert (Digits_Value (Base_Type (E)) = 15); - Get_External_Name (E, True, "XFG"); - end if; - -- Discrete case where bounds do not match size elsif Is_Discrete_Type (E) diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index c687cdd..eefc9c9 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -540,31 +540,6 @@ package Exp_Dbug is -- delta. In this case, the first nn/dd rational value is for delta, -- and the second value is for small. - ------------------------------ - -- VAX Floating-Point Types -- - ------------------------------ - - -- Vax floating-point types are represented at run time as integer - -- types, which are treated specially by the code generator. Their - -- type names are encoded with the following suffix: - - -- typ___XFF - -- typ___XFD - -- typ___XFG - - -- representing the Vax F Float, D Float, and G Float types. The - -- debugger must treat these specially. In particular, printing these - -- values can be achieved using the debug procedures that are provided - -- in package System.Vax_Float_Operations: - - -- procedure Debug_Output_D (Arg : D); - -- procedure Debug_Output_F (Arg : F); - -- procedure Debug_Output_G (Arg : G); - - -- These three procedures take a Vax floating-point argument, and - -- output a corresponding decimal representation to standard output - -- with no terminating line return. - -------------------- -- Discrete Types -- -------------------- diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index c264b50..387b32f 100644 --- a/gcc/ada/exp_smem.adb +++ b/gcc/ada/exp_smem.adb @@ -212,17 +212,9 @@ package body Exp_Smem is -- Mark object as locked in the current (transient) scope - declare - Locked_Shared_Objects : Elist_Id renames - Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects; - - begin - if Locked_Shared_Objects = No_Elist then - Locked_Shared_Objects := New_Elmt_List; - end if; - - Append_Elmt (Obj, To => Locked_Shared_Objects); - end; + Append_New_Elmt + (Obj, + To => Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects); -- First insert the Lock call before diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 1908130..e499701 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -7233,9 +7233,8 @@ package body Freeze is or else Nkind_In (Dcopy, N_Expanded_Name, N_Integer_Literal, N_Character_Literal, - N_String_Literal) - or else (Nkind (Dcopy) = N_Real_Literal - and then not Vax_Float (Etype (Dcopy))) + N_String_Literal, + N_Real_Literal) or else (Nkind (Dcopy) = N_Attribute_Reference and then Attribute_Name (Dcopy) = Name_Null_Parameter) or else Known_Null (Dcopy) diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 2eb9d98..6e6b5c5 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -475,11 +475,6 @@ procedure Gnat1drv is Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian; end if; - -- Temporarily set True_VMS_Target to OpenVMS_On_Target. This is just - -- temporary, we no longer deal with the debug flag -gnatdm here. - - Opt.True_VMS_Target := Targparm.OpenVMS_On_Target; - -- Activate front end layout if debug flag -gnatdF is set if Debug_Flag_FF then diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 05f79b8..24db2f2 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -2883,13 +2883,7 @@ MECHANISM ::= MECHANISM_ASSOCIATION ::= [formal_parameter_NAME =>] MECHANISM_NAME -MECHANISM_NAME ::= - Value -| Reference -| Descriptor [([Class =>] CLASS_NAME)] -| Short_Descriptor [([Class =>] CLASS_NAME)] - -CLASS_NAME ::= ubs | ubsb | uba | s | sb | a +MECHANISM_NAME ::= Value | Reference @end smallexample @noindent @@ -2917,13 +2911,6 @@ using positional notation to match parameters with subtype marks. The form with an @code{'Access} attribute can be used to match an anonymous access parameter. -@cindex OpenVMS -@cindex Passing by descriptor -Passing by descriptor is supported only on the OpenVMS ports of GNAT@. -The default behavior for Export_Function is to accept either 64bit or -32bit descriptors unless short_descriptor is specified, then only 32bit -descriptors are accepted. - @cindex Suppressing external name Special treatment is given if the EXTERNAL is an explicit null string or a static string expressions that evaluates to the null @@ -2988,13 +2975,7 @@ MECHANISM ::= MECHANISM_ASSOCIATION ::= [formal_parameter_NAME =>] MECHANISM_NAME -MECHANISM_NAME ::= - Value -| Reference -| Descriptor [([Class =>] CLASS_NAME)] -| Short_Descriptor [([Class =>] CLASS_NAME)] - -CLASS_NAME ::= ubs | ubsb | uba | s | sb | a +MECHANISM_NAME ::= Value | Reference @end smallexample @noindent @@ -3007,13 +2988,6 @@ not what is wanted, so it is usually appropriate to use this pragma in conjunction with a @code{Export} or @code{Convention} pragma that specifies the desired foreign convention. -@cindex OpenVMS -@cindex Passing by descriptor -Passing by descriptor is supported only on the OpenVMS ports of GNAT@. -The default behavior for Export_Procedure is to accept either 64bit or -32bit descriptors unless short_descriptor is specified, then only 32bit -descriptors are accepted. - @cindex Suppressing external name Special treatment is given if the EXTERNAL is an explicit null string or a static string expressions that evaluates to the null @@ -3074,13 +3048,7 @@ MECHANISM ::= MECHANISM_ASSOCIATION ::= [formal_parameter_NAME =>] MECHANISM_NAME -MECHANISM_NAME ::= - Value -| Reference -| Descriptor [([Class =>] CLASS_NAME)] -| Short_Descriptor [([Class =>] CLASS_NAME)] - -CLASS_NAME ::= ubs | ubsb | uba | s | sb | a +MECHANISM_NAME ::= Value | Reference @end smallexample @noindent @@ -3098,13 +3066,6 @@ with foreign language functions, so it is usually appropriate to use this pragma in conjunction with a @code{Export} or @code{Convention} pragma that specifies the desired foreign convention. -@cindex OpenVMS -@cindex Passing by descriptor -Passing by descriptor is supported only on the OpenVMS ports of GNAT@. -The default behavior for Export_Valued_Procedure is to accept either 64bit or -32bit descriptors unless short_descriptor is specified, then only 32bit -descriptors are accepted. - @cindex Suppressing external name Special treatment is given if the EXTERNAL is an explicit null string or a static string expressions that evaluates to the null @@ -3608,8 +3569,7 @@ pragma Import_Function ( [, [Parameter_Types =>] PARAMETER_TYPES] [, [Result_Type =>] SUBTYPE_MARK] [, [Mechanism =>] MECHANISM] - [, [Result_Mechanism =>] MECHANISM_NAME] - [, [First_Optional_Parameter =>] IDENTIFIER]); + [, [Result_Mechanism =>] MECHANISM_NAME]); EXTERNAL_SYMBOL ::= IDENTIFIER @@ -3698,8 +3658,7 @@ pragma Import_Procedure ( [Internal =>] LOCAL_NAME [, [External =>] EXTERNAL_SYMBOL] [, [Parameter_Types =>] PARAMETER_TYPES] - [, [Mechanism =>] MECHANISM] - [, [First_Optional_Parameter =>] IDENTIFIER]); + [, [Mechanism =>] MECHANISM]); EXTERNAL_SYMBOL ::= IDENTIFIER @@ -3739,8 +3698,7 @@ pragma Import_Valued_Procedure ( [Internal =>] LOCAL_NAME [, [External =>] EXTERNAL_SYMBOL] [, [Parameter_Types =>] PARAMETER_TYPES] - [, [Mechanism =>] MECHANISM] - [, [First_Optional_Parameter =>] IDENTIFIER]); + [, [Mechanism =>] MECHANISM]); EXTERNAL_SYMBOL ::= IDENTIFIER @@ -6405,11 +6363,8 @@ pragma Short_Descriptors @end smallexample @noindent -In VMS versions of the compiler, this configuration pragma causes all -occurrences of the mechanism types Descriptor[_xxx] to be treated as -Short_Descriptor[_xxx]. This is helpful in porting legacy applications from a -32-bit environment to a 64-bit environment. This pragma is ignored for non-VMS -versions. +This pragma is provided for compatibility with other Ada implementations. It +is recognized but ignored by all current versions of GNAT. @node Pragma Simple_Storage_Pool_Type @unnumberedsec Pragma Simple_Storage_Pool_Type diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index ffbeb95..354054f 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1180,7 +1180,7 @@ procedure GNATCmd is for C in Command_List'Range loop - -- No usage for VMS only command or for Sync + -- No usage for Sync if C /= Sync then if Targparm.AAMP_On_Target then diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 04ca7ca..6434159 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -518,11 +518,7 @@ package body Inline is procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id) is begin - if Backend_Inlined_Subps = No_Elist then - Backend_Inlined_Subps := New_Elmt_List; - end if; - - Append_Elmt (Subp, To => Backend_Inlined_Subps); + Append_New_Elmt (Subp, To => Backend_Inlined_Subps); end Register_Backend_Inlined_Subprogram; --------------------------------------------- @@ -531,11 +527,7 @@ package body Inline is procedure Register_Backend_Not_Inlined_Subprogram (Subp : Entity_Id) is begin - if Backend_Not_Inlined_Subps = No_Elist then - Backend_Not_Inlined_Subps := New_Elmt_List; - end if; - - Append_Elmt (Subp, To => Backend_Not_Inlined_Subps); + Append_New_Elmt (Subp, To => Backend_Not_Inlined_Subps); end Register_Backend_Not_Inlined_Subprogram; -- Start of processing for Add_Inlined_Subprogram @@ -2802,11 +2794,7 @@ package body Inline is -- Register the call in the list of inlined calls - if Inlined_Calls = No_Elist then - Inlined_Calls := New_Elmt_List; - end if; - - Append_Elmt (N, To => Inlined_Calls); + Append_New_Elmt (N, To => Inlined_Calls); -- Use generic machinery to copy body of inlined subprogram, as if it -- were an instantiation, resetting source locations appropriately, so @@ -4027,11 +4015,7 @@ package body Inline is procedure Register_Backend_Call (N : Node_Id) is begin - if Backend_Calls = No_Elist then - Backend_Calls := New_Elmt_List; - end if; - - Append_Elmt (N, To => Backend_Calls); + Append_New_Elmt (N, To => Backend_Calls); end Register_Backend_Call; -------------------------- diff --git a/gcc/ada/mlib-tgt.ads b/gcc/ada/mlib-tgt.ads index cbb15d3..0260159 100644 --- a/gcc/ada/mlib-tgt.ads +++ b/gcc/ada/mlib-tgt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2009, AdaCore -- +-- Copyright (C) 2001-2014, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -132,8 +132,8 @@ package MLib.Tgt is -- "libtoto.so" will be a symbolic link to "libtoto.so.2.1" which -- will be the actual library file. -- - -- Symbol_Data is used for some platforms, including VMS, to generate - -- the symbols to be exported by the library. + -- Symbol_Data is used for some platforms, to generate the symbols to be + -- exported by the library (not certain if it is currently in use or not). -- -- Note: Depending on the OS, some of the parameters may not be taken into -- account. For example, on Linux, Interfaces, Symbol_Data and Auto_Init diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 115500d..4144340 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -63,7 +63,6 @@ package body Opt is Optimize_Alignment_Config := Optimize_Alignment; Persistent_BSS_Mode_Config := Persistent_BSS_Mode; Polling_Required_Config := Polling_Required; - Short_Descriptors_Config := Short_Descriptors; SPARK_Mode_Config := SPARK_Mode; SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma; Uneval_Old_Config := Uneval_Old; @@ -103,7 +102,6 @@ package body Opt is Optimize_Alignment_Local := Save.Optimize_Alignment_Local; Persistent_BSS_Mode := Save.Persistent_BSS_Mode; Polling_Required := Save.Polling_Required; - Short_Descriptors := Save.Short_Descriptors; SPARK_Mode := Save.SPARK_Mode; SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma; Uneval_Old := Save.Uneval_Old; @@ -144,7 +142,6 @@ package body Opt is Save.Optimize_Alignment_Local := Optimize_Alignment_Local; Save.Persistent_BSS_Mode := Persistent_BSS_Mode; Save.Polling_Required := Polling_Required; - Save.Short_Descriptors := Short_Descriptors; Save.SPARK_Mode := SPARK_Mode; Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma; Save.Uneval_Old := Uneval_Old; @@ -244,7 +241,6 @@ package body Opt is Fast_Math := Fast_Math_Config; Optimize_Alignment := Optimize_Alignment_Config; Polling_Required := Polling_Required_Config; - Short_Descriptors := Short_Descriptors_Config; end Set_Opt_Config_Switches; --------------- diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 68d20f1..7993155 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -418,12 +418,9 @@ package Opt is subtype Debug_Level_Value is Nat range 0 .. 3; Debugger_Level : Debug_Level_Value := 0; - -- GNATBIND -- The value given to the -g parameter. The default value for -g with - -- no value is 2. This is usually ignored by GNATBIND, except in the - -- VMS version where it is passed as an argument to __gnat_initialize - -- to trigger the activation of the remote debugging interface. - -- Is this still true ??? + -- no value is 2. This is not currently used but is retained for possible + -- future use. Default_Exit_Status : Int := 0; -- GNATBIND @@ -709,11 +706,6 @@ package Opt is -- GNAT -- True if compiling in GNAT system mode (-gnatg switch) - Heap_Size : Nat := 0; - -- GNATBIND - -- Heap size for memory allocations. Valid values are 32 and 64. Only - -- available on VMS. - Identifier_Character_Set : Character; -- GNAT -- This variable indicates the character set to be used for identifiers. @@ -1291,10 +1283,6 @@ package Opt is -- GNAT -- Set True if a pragma Short_Circuit_And_Or applies to the current unit. - Short_Descriptors : Boolean := False; - -- GNAT - -- Set True if a pragma Short_Descriptors applies to the current unit. - type SPARK_Mode_Type is (None, Off, On); -- Possible legal modes that can be set by aspect/pragma SPARK_Mode, as -- well as the value None, which indicates no such pragma/aspect applies. @@ -1463,12 +1451,6 @@ package Opt is -- GNAT -- Set to True (-gnatt) to generate output tree file - True_VMS_Target : Boolean := False; - -- Set True if we are on a VMS target. The setting of this flag reflects - -- the true state of the compile, unlike Targparm.OpenVMS_On_Target which - -- can also be true when debug flag m is set (-gnatdm). This is used in the - -- few cases where we do NOT want -gnatdm to trigger the VMS behavior. - Try_Semantics : Boolean := False; -- GNAT -- Flag set to force attempt at semantic analysis, even if parser errors @@ -1955,14 +1937,6 @@ package Opt is -- flag is used to set the initial value for Polling_Required at the start -- of analyzing each unit. - Short_Descriptors_Config : Boolean; - -- GNAT - -- This is the value of the configuration switch that controls the use of - -- Short_Descriptors for setting descriptor default sizes. It can be set - -- True by the use of the pragma Short_Descriptors in the gnat.adc file. - -- This flag is used to set the initial value for Short_Descriptors at the - -- start of analyzing each unit. - SPARK_Mode_Config : SPARK_Mode_Type := None; -- GNAT -- The setting of SPARK_Mode from configuration pragmas @@ -2143,7 +2117,6 @@ private Optimize_Alignment_Local : Boolean; Persistent_BSS_Mode : Boolean; Polling_Required : Boolean; - Short_Descriptors : Boolean; SPARK_Mode : SPARK_Mode_Type; SPARK_Mode_Pragma : Node_Id; Uneval_Old : Character; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index e1853fa..f1a4082 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -374,7 +374,6 @@ package Rtsfind is System_Val_Real, System_Val_Uns, System_Val_WChar, - System_Vax_Float_Operations, System_Version_Control, System_WCh_StW, System_WCh_WtS, @@ -1636,56 +1635,6 @@ package Rtsfind is RE_Value_Wide_Character, -- System.Val_WChar RE_Value_Wide_Wide_Character, -- System.Val_WChar - RE_D, -- System.Vax_Float_Operations - RE_F, -- System.Vax_Float_Operations - RE_G, -- System.Vax_Float_Operations - RE_Q, -- System.Vax_Float_Operations - RE_S, -- System.Vax_Float_Operations - RE_T, -- System.Vax_Float_Operations - - RE_D_To_G, -- System.Vax_Float_Operations - RE_F_To_G, -- System.Vax_Float_Operations - RE_F_To_Q, -- System.Vax_Float_Operations - RE_F_To_S, -- System.Vax_Float_Operations - RE_G_To_D, -- System.Vax_Float_Operations - RE_G_To_F, -- System.Vax_Float_Operations - RE_G_To_Q, -- System.Vax_Float_Operations - RE_G_To_T, -- System.Vax_Float_Operations - RE_Q_To_F, -- System.Vax_Float_Operations - RE_Q_To_G, -- System.Vax_Float_Operations - RE_S_To_F, -- System.Vax_Float_Operations - RE_T_To_D, -- System.Vax_Float_Operations - RE_T_To_G, -- System.Vax_Float_Operations - - RE_Abs_F, -- System.Vax_Float_Operations - RE_Abs_G, -- System.Vax_Float_Operations - RE_Add_F, -- System.Vax_Float_Operations - RE_Add_G, -- System.Vax_Float_Operations - RE_Div_F, -- System.Vax_Float_Operations - RE_Div_G, -- System.Vax_Float_Operations - RE_Mul_F, -- System.Vax_Float_Operations - RE_Mul_G, -- System.Vax_Float_Operations - RE_Neg_F, -- System.Vax_Float_Operations - RE_Neg_G, -- System.Vax_Float_Operations - RE_Return_D, -- System.Vax_Float_Operations - RE_Return_F, -- System.Vax_Float_Operations - RE_Return_G, -- System.Vax_Float_Operations - RE_Sub_F, -- System.Vax_Float_Operations - RE_Sub_G, -- System.Vax_Float_Operations - - RE_Eq_F, -- System.Vax_Float_Operations - RE_Eq_G, -- System.Vax_Float_Operations - RE_Le_F, -- System.Vax_Float_Operations - RE_Le_G, -- System.Vax_Float_Operations - RE_Lt_F, -- System.Vax_Float_Operations - RE_Lt_G, -- System.Vax_Float_Operations - RE_Ne_F, -- System.Vax_Float_Operations - RE_Ne_G, -- System.Vax_Float_Operations - - RE_Valid_D, -- System.Vax_Float_Operations - RE_Valid_F, -- System.Vax_Float_Operations - RE_Valid_G, -- System.Vax_Float_Operations - RE_Version_String, -- System.Version_Control RE_Get_Version_String, -- System.Version_Control @@ -2921,56 +2870,6 @@ package Rtsfind is RE_Value_Wide_Character => System_Val_WChar, RE_Value_Wide_Wide_Character => System_Val_WChar, - RE_D => System_Vax_Float_Operations, - RE_F => System_Vax_Float_Operations, - RE_G => System_Vax_Float_Operations, - RE_Q => System_Vax_Float_Operations, - RE_S => System_Vax_Float_Operations, - RE_T => System_Vax_Float_Operations, - - RE_D_To_G => System_Vax_Float_Operations, - RE_F_To_G => System_Vax_Float_Operations, - RE_F_To_Q => System_Vax_Float_Operations, - RE_F_To_S => System_Vax_Float_Operations, - RE_G_To_D => System_Vax_Float_Operations, - RE_G_To_F => System_Vax_Float_Operations, - RE_G_To_Q => System_Vax_Float_Operations, - RE_G_To_T => System_Vax_Float_Operations, - RE_Q_To_F => System_Vax_Float_Operations, - RE_Q_To_G => System_Vax_Float_Operations, - RE_S_To_F => System_Vax_Float_Operations, - RE_T_To_D => System_Vax_Float_Operations, - RE_T_To_G => System_Vax_Float_Operations, - - RE_Abs_F => System_Vax_Float_Operations, - RE_Abs_G => System_Vax_Float_Operations, - RE_Add_F => System_Vax_Float_Operations, - RE_Add_G => System_Vax_Float_Operations, - RE_Div_F => System_Vax_Float_Operations, - RE_Div_G => System_Vax_Float_Operations, - RE_Mul_F => System_Vax_Float_Operations, - RE_Mul_G => System_Vax_Float_Operations, - RE_Neg_F => System_Vax_Float_Operations, - RE_Neg_G => System_Vax_Float_Operations, - RE_Return_D => System_Vax_Float_Operations, - RE_Return_F => System_Vax_Float_Operations, - RE_Return_G => System_Vax_Float_Operations, - RE_Sub_F => System_Vax_Float_Operations, - RE_Sub_G => System_Vax_Float_Operations, - - RE_Eq_F => System_Vax_Float_Operations, - RE_Eq_G => System_Vax_Float_Operations, - RE_Le_F => System_Vax_Float_Operations, - RE_Le_G => System_Vax_Float_Operations, - RE_Lt_F => System_Vax_Float_Operations, - RE_Lt_G => System_Vax_Float_Operations, - RE_Ne_F => System_Vax_Float_Operations, - RE_Ne_G => System_Vax_Float_Operations, - - RE_Valid_D => System_Vax_Float_Operations, - RE_Valid_F => System_Vax_Float_Operations, - RE_Valid_G => System_Vax_Float_Operations, - RE_Version_String => System_Version_Control, RE_Get_Version_String => System_Version_Control, diff --git a/gcc/ada/s-auxdec.ads b/gcc/ada/s-auxdec.ads index 6c585cc..6ce87bd 100644 --- a/gcc/ada/s-auxdec.ads +++ b/gcc/ada/s-auxdec.ads @@ -39,13 +39,7 @@ package System.Aux_DEC is pragma Preelaborate; subtype Short_Address is Address; - -- In some versions of System.Aux_DEC, notably that for VMS on IA64, there - -- are two address types (64-bit and 32-bit), and the name Short_Address - -- is used for the short address form. To avoid difficulties (in regression - -- tests and elsewhere) with units that reference Short_Address, it is - -- provided for other targets as a synonym for the normal Address type, - -- and, as in the case where the lengths are different, Address and - -- Short_Address can be freely inter-converted. + -- For compatibility with systems having short and long addresses type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1; for Integer_8'Size use 8; @@ -112,7 +106,7 @@ package System.Aux_DEC is type F_Float is digits 6; type D_Float is digits 9; type G_Float is digits 15; - -- We provide the type names, but these will be IEEE, not VMS format + -- We provide the type names, but these will be IEEE format, not VAX format -- Floating point type declarations for IEEE floating point data types diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb index 259b9d1..01bb2b4 100644 --- a/gcc/ada/s-fatgen.adb +++ b/gcc/ada/s-fatgen.adb @@ -756,12 +756,7 @@ package body System.Fat_Gen is -- Valid -- ----------- - -- Note: this routine does not work for VAX float. We compensate for this - -- in Exp_Attr by using the Valid functions in Vax_Float_Operations rather - -- than the corresponding instantiation of this function. - function Valid (X : not null access T) return Boolean is - IEEE_Emin : constant Integer := T'Machine_Emin - 1; IEEE_Emax : constant Integer := T'Machine_Emax - 1; diff --git a/gcc/ada/s-fatgen.ads b/gcc/ada/s-fatgen.ads index 13e7885..6c4e6f7 100644 --- a/gcc/ada/s-fatgen.ads +++ b/gcc/ada/s-fatgen.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -95,8 +95,6 @@ package System.Fat_Gen is -- register, and the whole point of 'Valid is to prevent exceptions. -- Note that the object of type T must have the natural alignment -- for type T. See Unaligned_Valid for further discussion. - -- - -- Note: this routine does not work for Vax_Float ??? function Unaligned_Valid (A : System.Address) return Boolean; -- This version of Valid is used if the floating-point value to @@ -114,8 +112,6 @@ package System.Fat_Gen is -- not require strict alignment (e.g. the ia32/x86), since on a -- target not requiring strict alignment, it is fine to pass a -- non-aligned value to the standard Valid routine. - -- - -- Note: this routine does not work for Vax_Float ??? private pragma Inline (Machine); diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 49d868f..8ea87f2 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -1851,6 +1851,7 @@ package body System.OS_Lib is (Host_File : System.Address) return System.Address; pragma Import (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec"); + -- Convert possible foreign file syntax to canonical form The_Name : String (1 .. Name'Length + 1); Canonical_File_Addr : System.Address; @@ -1978,19 +1979,19 @@ package body System.OS_Lib is return ""; end if; - -- First, convert VMS file spec to Unix file spec. - -- If Name is not in VMS syntax, then this is equivalent - -- to put Name at the beginning of Path_Buffer. + -- First, convert possible foreign file spec to Unix file spec. If no + -- conversion is required, all this does is put Name at the beginning + -- of Path_Buffer unchanged. - VMS_Conversion : begin + File_Name_Conversion : begin The_Name (1 .. Name'Length) := Name; The_Name (The_Name'Last) := ASCII.NUL; Canonical_File_Addr := To_Canonical_File_Spec (The_Name'Address); Canonical_File_Len := Integer (CRTL.strlen (Canonical_File_Addr)); - -- If VMS syntax conversion has failed, return an empty string - -- to indicate the failure. + -- If syntax conversion has failed, return an empty string to + -- indicate the failure. if Canonical_File_Len = 0 then return ""; @@ -2007,7 +2008,7 @@ package body System.OS_Lib is End_Path := Canonical_File_Len; Last := 1; end; - end VMS_Conversion; + end File_Name_Conversion; -- Replace all '/' by Directory Separators (this is for Windows) diff --git a/gcc/ada/s-shasto.ads b/gcc/ada/s-shasto.ads index 0ef65cc..51e49e8 100644 --- a/gcc/ada/s-shasto.ads +++ b/gcc/ada/s-shasto.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2014, 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- -- @@ -36,10 +36,6 @@ -- provides a more general implementation not dedicated to file -- storage. --- This unit (and shared passive partitions) are supported on all --- GNAT implementations except on OpenVMS (where problems arise from --- trying to share files, and with version numbers of files) - -- -------------------------- -- -- Shared Storage Model -- -- -------------------------- diff --git a/gcc/ada/s-stalib.ads b/gcc/ada/s-stalib.ads index 520fb3c..c7f28fe 100644 --- a/gcc/ada/s-stalib.ads +++ b/gcc/ada/s-stalib.ads @@ -106,7 +106,6 @@ package System.Standard_Library is Lang : Character; -- A character indicating the language raising the exception. -- Set to "A" for exceptions defined by an Ada program. - -- Set to "V" for imported VMS exceptions. -- Set to "C" for imported C++ exceptions. Name_Length : Natural; @@ -122,9 +121,8 @@ package System.Standard_Library is -- identities and names. Foreign_Data : Address; - -- Data for imported exceptions. This represents the exception code - -- for the handling of Import/Export_Exception for the VMS case. - -- This represents the address of the RTTI for the C++ case. + -- Data for imported exceptions. Not used in the Ada case. This + -- represents the address of the RTTI for the C++ case. Raise_Hook : Raise_Action; -- This field can be used to place a "hook" on an exception. If the diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 0da096e..eb3501e 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1482,13 +1482,7 @@ package body Sem is null; else - -- Initialize if first time - - if No (Comp_Unit_List) then - Comp_Unit_List := New_Elmt_List; - end if; - - Append_Elmt (Comp_Unit, Comp_Unit_List); + Append_New_Elmt (Comp_Unit, To => Comp_Unit_List); if Debug_Unit_Walk then Write_Str ("Appending "); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index e0d2d9e..599212f 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6264,11 +6264,7 @@ package body Sem_Attr is -- Mark this component as processed else - if No (Comps) then - Comps := New_Elmt_List; - end if; - - Append_Elmt (Comp_Or_Discr, Comps); + Append_New_Elmt (Comp_Or_Discr, Comps); end if; end if; @@ -6787,9 +6783,6 @@ package body Sem_Attr is -- Computes the Fore value for the current attribute prefix, which is -- known to be a static fixed-point type. Used by Fore and Width. - function Is_VAX_Float (Typ : Entity_Id) return Boolean; - -- Determine whether Typ denotes a VAX floating point type - function Mantissa return Uint; -- Returns the Mantissa value for the prefix type @@ -6921,16 +6914,6 @@ package body Sem_Attr is return R; end Fore_Value; - ------------------ - -- Is_VAX_Float -- - ------------------ - - function Is_VAX_Float (Typ : Entity_Id) return Boolean is - pragma Unreferenced (Typ); - begin - return False; - end Is_VAX_Float; - -------------- -- Mantissa -- -------------- @@ -7953,16 +7936,6 @@ package body Sem_Attr is Fold_Uint (N, Expr_Value (Lo_Bound), Static); end if; - -- Replace VAX Float_Type'First with a reference to the temporary - -- which represents the low bound of the type. This transformation - -- is needed since the back end cannot evaluate 'First on VAX. - - elsif Is_VAX_Float (P_Type) - and then Nkind (Lo_Bound) = N_Identifier - then - Rewrite (N, New_Occurrence_Of (Entity (Lo_Bound), Sloc (N))); - Analyze (N); - else Check_Concurrent_Discriminant (Lo_Bound); end if; @@ -8206,16 +8179,6 @@ package body Sem_Attr is Fold_Uint (N, Expr_Value (Hi_Bound), Static); end if; - -- Replace VAX Float_Type'Last with a reference to the temporary - -- which represents the high bound of the type. This transformation - -- is needed since the back end cannot evaluate 'Last on VAX. - - elsif Is_VAX_Float (P_Type) - and then Nkind (Hi_Bound) = N_Identifier - then - Rewrite (N, New_Occurrence_Of (Entity (Hi_Bound), Sloc (N))); - Analyze (N); - else Check_Concurrent_Discriminant (Hi_Bound); end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 7927570..a776894 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1751,9 +1751,7 @@ package body Sem_Ch12 is -- If this is a nested generic, preserve default for later -- instantiations. - if No (Match) - and then Box_Present (Formal) - then + if No (Match) and then Box_Present (Formal) then Append_Elmt (Defining_Unit_Name (Specification (Last (Assoc))), Default_Actuals); @@ -8919,12 +8917,7 @@ package body Sem_Ch12 is and then Remove_Suffix (Prim_A, 'P') = Chars (Prim_G) then Set_Chars (Prim_A, Chars (Prim_G)); - - if List = No_Elist then - List := New_Elmt_List; - end if; - - Append_Elmt (Prim_A, List); + Append_New_Elmt (Prim_A, To => List); end if; Next_Elmt (Prim_A_Elmt); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 54f8f23..586a84e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -326,11 +326,7 @@ package body Sem_Prag is procedure Add_Item (Item : Entity_Id; To_List : in out Elist_Id) is begin - if No (To_List) then - To_List := New_Elmt_List; - end if; - - Append_Elmt (Item, To_List); + Append_New_Elmt (Item, To => To_List); end Add_Item; ------------------------------- @@ -3248,8 +3244,7 @@ package body Sem_Prag is Arg_Parameter_Types : Node_Id; Arg_Result_Type : Node_Id := Empty; Arg_Mechanism : Node_Id; - Arg_Result_Mechanism : Node_Id := Empty; - Arg_First_Optional_Parameter : Node_Id := Empty); + Arg_Result_Mechanism : Node_Id := Empty); -- Common processing for all extended Import and Export pragmas applying -- to subprograms. The caller omits any arguments that do not apply to -- the pragma in question (for example, Arg_Result_Type can be non-Empty @@ -7309,13 +7304,8 @@ package body Sem_Prag is Arg_Parameter_Types : Node_Id; Arg_Result_Type : Node_Id := Empty; Arg_Mechanism : Node_Id; - Arg_Result_Mechanism : Node_Id := Empty; - Arg_First_Optional_Parameter : Node_Id := Empty) + Arg_Result_Mechanism : Node_Id := Empty) is - pragma Unreferenced (Arg_First_Optional_Parameter); - -- We ignore the First_Optional_Parameter argument. It was only - -- relevant for VMS anyway, and otherwise ignored. - Ent : Entity_Id; Def_Id : Entity_Id; Hom_Id : Entity_Id; @@ -9317,9 +9307,9 @@ package body Sem_Prag is if Warn_On_Export_Import -- Only do this for something that was in the source. Not - -- clear if this can be False now (there used for sure to - -- be cases on VMS where it was False), but anyway the test - -- is harmless if not needed, so it is retained. + -- clear if this can be False now (there used for sure to be + -- cases on some systems where it was False), but anyway the + -- test is harmless if not needed, so it is retained. and then Comes_From_Source (Arg) then @@ -13535,9 +13525,6 @@ package body Sem_Prag is -- MECHANISM_NAME ::= -- Value -- | Reference - -- | Descriptor [([Class =>] CLASS_NAME)] - - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca when Pragma_Export_Function => Export_Function : declare Args : Args_List (1 .. 6); @@ -13599,9 +13586,6 @@ package body Sem_Prag is -- MECHANISM_NAME ::= -- Value -- | Reference - -- | Descriptor [([Class =>] CLASS_NAME)] - - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca when Pragma_Export_Object => Export_Object : declare Args : Args_List (1 .. 3); @@ -13655,9 +13639,6 @@ package body Sem_Prag is -- MECHANISM_NAME ::= -- Value -- | Reference - -- | Descriptor [([Class =>] CLASS_NAME)] - - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca when Pragma_Export_Procedure => Export_Procedure : declare Args : Args_List (1 .. 4); @@ -13733,9 +13714,6 @@ package body Sem_Prag is -- MECHANISM_NAME ::= -- Value -- | Reference - -- | Descriptor [([Class =>] CLASS_NAME)] - - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca when Pragma_Export_Valued_Procedure => Export_Valued_Procedure : declare @@ -14071,10 +14049,8 @@ package body Sem_Prag is -- pragma Ident (static_string_EXPRESSION) - -- Note: pragma Comment shares this processing. Pragma Comment is - -- identical to Ident, except that the restriction of the argument to - -- 31 characters and the placement restrictions are not enforced for - -- pragma Comment. + -- Note: pragma Comment shares this processing. Pragma Ident is + -- identical in effect to pragma Commment. when Pragma_Ident | Pragma_Comment => Ident : declare Str : Node_Id; @@ -14086,13 +14062,6 @@ package body Sem_Prag is Check_Arg_Is_OK_Static_Expression (Arg1, Standard_String); Store_Note (N); - -- For pragma Ident, preserve DEC compatibility by requiring the - -- pragma to appear in a declarative part or package spec. - - if Prag_Id = Pragma_Ident then - Check_Is_In_Decl_Part_Or_Package_Spec; - end if; - Str := Expr_Value_S (Get_Pragma_Arg (Arg1)); declare @@ -14116,15 +14085,10 @@ package body Sem_Prag is if Present (CS) then - -- For Ident, we do not permit multiple instances - - if Prag_Id = Pragma_Ident then - Error_Pragma ("duplicate% pragma not permitted"); - - -- For Comment, we concatenate the string, unless we want - -- to preserve the tree structure for ASIS. + -- If we have multiple instances, concatenate them, but + -- not in ASIS, where we want the original tree. - elsif not ASIS_Mode then + if not ASIS_Mode then Start_String (Strval (CS)); Store_String_Char (' '); Store_String_Chars (Strval (Str)); @@ -14141,15 +14105,6 @@ package body Sem_Prag is elsif Nkind (GP) = N_Subunit then null; - - -- Otherwise we have a misplaced pragma Ident, but we ignore - -- this if we are in an instantiation, since it comes from - -- a generic, and has no relevance to the instantiation. - - elsif Prag_Id = Pragma_Ident then - if Instantiation_Location (Loc) = No_Location then - Error_Pragma ("pragma% only allowed at outer level"); - end if; end if; end; end Ident; @@ -14338,8 +14293,7 @@ package body Sem_Prag is -- [, [Parameter_Types =>] (PARAMETER_TYPES)] -- [, [Result_Type =>] SUBTYPE_MARK] -- [, [Mechanism =>] MECHANISM] - -- [, [Result_Mechanism =>] MECHANISM_NAME] - -- [, [First_Optional_Parameter =>] IDENTIFIER]); + -- [, [Result_Mechanism =>] MECHANISM_NAME]); -- EXTERNAL_SYMBOL ::= -- IDENTIFIER @@ -14363,20 +14317,16 @@ package body Sem_Prag is -- MECHANISM_NAME ::= -- Value -- | Reference - -- | Descriptor [([Class =>] CLASS_NAME)] - - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca when Pragma_Import_Function => Import_Function : declare - Args : Args_List (1 .. 7); - Names : constant Name_List (1 .. 7) := ( + Args : Args_List (1 .. 6); + Names : constant Name_List (1 .. 6) := ( Name_Internal, Name_External, Name_Parameter_Types, Name_Result_Type, Name_Mechanism, - Name_Result_Mechanism, - Name_First_Optional_Parameter); + Name_Result_Mechanism); Internal : Node_Id renames Args (1); External : Node_Id renames Args (2); @@ -14384,7 +14334,6 @@ package body Sem_Prag is Result_Type : Node_Id renames Args (4); Mechanism : Node_Id renames Args (5); Result_Mechanism : Node_Id renames Args (6); - First_Optional_Parameter : Node_Id renames Args (7); begin GNAT_Pragma; @@ -14395,8 +14344,7 @@ package body Sem_Prag is Arg_Parameter_Types => Parameter_Types, Arg_Result_Type => Result_Type, Arg_Mechanism => Mechanism, - Arg_Result_Mechanism => Result_Mechanism, - Arg_First_Optional_Parameter => First_Optional_Parameter); + Arg_Result_Mechanism => Result_Mechanism); end Import_Function; ------------------- @@ -14440,8 +14388,7 @@ package body Sem_Prag is -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Parameter_Types =>] (PARAMETER_TYPES)] - -- [, [Mechanism =>] MECHANISM] - -- [, [First_Optional_Parameter =>] IDENTIFIER]); + -- [, [Mechanism =>] MECHANISM]); -- EXTERNAL_SYMBOL ::= -- IDENTIFIER @@ -14465,24 +14412,19 @@ package body Sem_Prag is -- MECHANISM_NAME ::= -- Value -- | Reference - -- | Descriptor [([Class =>] CLASS_NAME)] - - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca when Pragma_Import_Procedure => Import_Procedure : declare - Args : Args_List (1 .. 5); - Names : constant Name_List (1 .. 5) := ( + Args : Args_List (1 .. 4); + Names : constant Name_List (1 .. 4) := ( Name_Internal, Name_External, Name_Parameter_Types, - Name_Mechanism, - Name_First_Optional_Parameter); + Name_Mechanism); Internal : Node_Id renames Args (1); External : Node_Id renames Args (2); Parameter_Types : Node_Id renames Args (3); Mechanism : Node_Id renames Args (4); - First_Optional_Parameter : Node_Id renames Args (5); begin GNAT_Pragma; @@ -14491,8 +14433,7 @@ package body Sem_Prag is Arg_Internal => Internal, Arg_External => External, Arg_Parameter_Types => Parameter_Types, - Arg_Mechanism => Mechanism, - Arg_First_Optional_Parameter => First_Optional_Parameter); + Arg_Mechanism => Mechanism); end Import_Procedure; ----------------------------- @@ -14503,8 +14444,7 @@ package body Sem_Prag is -- [Internal =>] LOCAL_NAME -- [, [External =>] EXTERNAL_SYMBOL] -- [, [Parameter_Types =>] (PARAMETER_TYPES)] - -- [, [Mechanism =>] MECHANISM] - -- [, [First_Optional_Parameter =>] IDENTIFIER]); + -- [, [Mechanism =>] MECHANISM]); -- EXTERNAL_SYMBOL ::= -- IDENTIFIER @@ -14528,25 +14468,20 @@ package body Sem_Prag is -- MECHANISM_NAME ::= -- Value -- | Reference - -- | Descriptor [([Class =>] CLASS_NAME)] - - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca when Pragma_Import_Valued_Procedure => Import_Valued_Procedure : declare - Args : Args_List (1 .. 5); - Names : constant Name_List (1 .. 5) := ( + Args : Args_List (1 .. 4); + Names : constant Name_List (1 .. 4) := ( Name_Internal, Name_External, Name_Parameter_Types, - Name_Mechanism, - Name_First_Optional_Parameter); + Name_Mechanism); Internal : Node_Id renames Args (1); External : Node_Id renames Args (2); Parameter_Types : Node_Id renames Args (3); Mechanism : Node_Id renames Args (4); - First_Optional_Parameter : Node_Id renames Args (5); begin GNAT_Pragma; @@ -14555,8 +14490,7 @@ package body Sem_Prag is Arg_Internal => Internal, Arg_External => External, Arg_Parameter_Types => Parameter_Types, - Arg_Mechanism => Mechanism, - Arg_First_Optional_Parameter => First_Optional_Parameter); + Arg_Mechanism => Mechanism); end Import_Valued_Procedure; ----------------- @@ -18910,11 +18844,12 @@ package body Sem_Prag is -- pragma Short_Descriptors; + -- Recognize and validate, but otherwise ignore + when Pragma_Short_Descriptors => GNAT_Pragma; Check_Arg_Count (0); Check_Valid_Configuration_Pragma; - Short_Descriptors := True; ------------------------------ -- Simple_Storage_Pool_Type -- @@ -25354,7 +25289,7 @@ package body Sem_Prag is Set_Body_References (State_Id, New_Elmt_List); end if; - Append_Elmt (Ref, Body_References (State_Id)); + Append_Elmt (Ref, To => Body_References (State_Id)); exit; end if; end if; diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index a97595c..4d6b1c0 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -262,13 +262,11 @@ package Sem_Prag is -- dealing with subprogram body stubs or expression functions. procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id); - -- This routine is used to set an encoded interface name. The node S is an - -- N_String_Literal node for the external name to be set, and E is an + -- This routine is used to set an encoded interface name. The node S is + -- an N_String_Literal node for the external name to be set, and E is an -- entity whose Interface_Name field is to be set. In the normal case where -- S contains a name that is a valid C identifier, then S is simply set as - -- the value of the Interface_Name. Otherwise it is encoded. See the body - -- for details of the encoding. This encoding is only done on VMS systems, - -- since it seems pretty silly, but is needed to pass some dubious tests in - -- the test suite. + -- the value of the Interface_Name. Otherwise it is encoded as needed by + -- particular operating systems. See the body for details of the encoding. end Sem_Prag; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f460898..44435ca 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1875,11 +1875,7 @@ package body Sem_Util is return Abandon; end if; - if Writable_Actuals_List = No_Elist then - Writable_Actuals_List := New_Elmt_List; - end if; - - Append_Elmt (N, Writable_Actuals_List); + Append_New_Elmt (N, To => Writable_Actuals_List); else if Identifiers_List = No_Elist then @@ -6128,9 +6124,7 @@ package body Sem_Util is declare Comp : constant Entity_Id := Defining_Identifier (Comp_Item); begin - if not Is_Tag (Comp) - and then Chars (Comp) /= Name_uParent - then + if not Is_Tag (Comp) and then Chars (Comp) /= Name_uParent then Append_Elmt (Comp, Into); end if; end; @@ -7410,9 +7404,7 @@ package body Sem_Util is function Has_Denormals (E : Entity_Id) return Boolean is begin - return Is_Floating_Point_Type (E) - and then Denorm_On_Target - and then not Vax_Float (E); + return Is_Floating_Point_Type (E) and then Denorm_On_Target; end Has_Denormals; ------------------------------------------- @@ -8369,9 +8361,7 @@ package body Sem_Util is function Has_Signed_Zeros (E : Entity_Id) return Boolean is begin - return Is_Floating_Point_Type (E) - and then Signed_Zeros_On_Target - and then not Vax_Float (E); + return Is_Floating_Point_Type (E) and then Signed_Zeros_On_Target; end Has_Signed_Zeros; ----------------------------- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 12ff465..14cf1e26 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -342,10 +342,6 @@ package Snames is -- Ada 83, Ada 95, and Ada 2005 mode as well, where they are technically -- considered to be implementation dependent pragmas. - -- The entries marked VMS are VMS specific pragmas that are recognized only - -- in OpenVMS versions of GNAT. They are ignored in other versions with an - -- appropriate warning. - -- The entries marked AAMP are AAMP specific pragmas that are recognized -- only in GNAT for the AAMP. They are ignored in other versions with -- appropriate warnings. @@ -579,7 +575,7 @@ package Snames is -- pragma. Name_Provide_Shift_Operators : constant Name_Id := N + $; -- GNAT - Name_Psect_Object : constant Name_Id := N + $; -- VMS + Name_Psect_Object : constant Name_Id := N + $; -- GNAT Name_Pure : constant Name_Id := N + $; Name_Pure_Function : constant Name_Id := N + $; -- GNAT Name_Refined_Depends : constant Name_Id := N + $; -- GNAT @@ -614,7 +610,7 @@ package Snames is Name_Test_Case : constant Name_Id := N + $; -- GNAT Name_Task_Info : constant Name_Id := N + $; -- GNAT Name_Task_Name : constant Name_Id := N + $; -- GNAT - Name_Task_Storage : constant Name_Id := N + $; -- VMS + Name_Task_Storage : constant Name_Id := N + $; -- GNAT Name_Thread_Local_Storage : constant Name_Id := N + $; -- GNAT Name_Time_Slice : constant Name_Id := N + $; -- GNAT Name_Title : constant Name_Id := N + $; -- GNAT diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads index 6bcd8cb..e93e9b4 100644 --- a/gcc/ada/stand.ads +++ b/gcc/ada/stand.ads @@ -443,8 +443,7 @@ package Stand is -- Entity for universal real type. The bounds of this type correspond to -- to the largest supported real type (i.e. Long_Long_Float). It is the -- type used for runtime calculations in type universal real. Note that - -- this type is always IEEE format, even if Long_Long_Float is Vax_Float - -- (and in that case the bounds don't correspond exactly). + -- this type is always IEEE format. Universal_Fixed : Entity_Id; -- Entity for universal fixed type. This is a type with arbitrary diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index db6407a..880540e 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -262,20 +262,6 @@ package body Switch.B is Ptr := Ptr + 1; Usage_Requested := True; - -- Processing for H switch - - when 'H' => - if Ptr = Max then - Bad_Switch (Switch_Chars); - end if; - - Ptr := Ptr + 1; - Scan_Nat (Switch_Chars, Max, Ptr, Heap_Size, C); - - if Heap_Size /= 32 and then Heap_Size /= 64 then - Bad_Switch (Switch_Chars); - end if; - -- Processing for i switch when 'i' => diff --git a/gcc/ada/system.ads b/gcc/ada/system.ads index 7f6f13b..9206c1f 100644 --- a/gcc/ada/system.ads +++ b/gcc/ada/system.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (Compiler Version) -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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 -- @@ -148,7 +148,6 @@ private Frontend_Layout : constant Boolean := False; Machine_Overflows : constant Boolean := False; Machine_Rounds : constant Boolean := True; - OpenVMS : constant Boolean := False; Preallocated_Stacks : constant Boolean := False; Signed_Zeros : constant Boolean := True; Stack_Check_Default : constant Boolean := False; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index b161466..84ed202 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -67,8 +67,6 @@ package body Targparm is SNZ, -- Signed_Zeros SSL, -- Suppress_Standard_Library UAM, -- Use_Ada_Main_Program_Name - VMS, -- OpenVMS - VXF, -- VAX Float ZCD); -- ZCX_By_Default Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False); @@ -105,8 +103,6 @@ package body Targparm is SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros"; SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library"; UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name"; - VMS_Str : aliased constant Source_Buffer := "OpenVMS"; - VXF_Str : aliased constant Source_Buffer := "VAX_Float"; ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default"; -- The following defines a set of pointers to the above strings, @@ -143,8 +139,6 @@ package body Targparm is SNZ_Str'Access, SSL_Str'Access, UAM_Str'Access, - VMS_Str'Access, - VXF_Str'Access, ZCD_Str'Access); ----------------------- @@ -678,8 +672,6 @@ package body Targparm is when SSL => Suppress_Standard_Library_On_Target := Result; when SNZ => Signed_Zeros_On_Target := Result; when UAM => Use_Ada_Main_Program_Name_On_Target := Result; - when VMS => OpenVMS_On_Target := Result; - when VXF => VAX_Float_On_Target := Result; when ZCD => ZCX_By_Default_On_Target := Result; goto Line_Loop_Continue; diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 21f2d6d..2fcc9a3 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -179,13 +179,13 @@ package Targparm is -- The default values here are used if no value is found in system.ads. -- This should normally happen if the special version of system.ads used - -- by the compiler itself is in use or if the value is only relevant to - -- a particular target (e.g. OpenVMS, AAMP). The default values are - -- suitable for use in normal environments. This approach allows the - -- possibility of new versions of the compiler (possibly with new system - -- parameters added) being used to compile older versions of the compiler - -- sources, as well as avoiding duplicating values in all system-*.ads - -- files for flags that are used on a few platforms only. + -- by the compiler itself is in use or if the value is only relevant to a + -- particular target (e.g. AAMP). The default values are suitable for use + -- in normal environments. This approach allows the possibility of new + -- versions of the compiler (possibly with new system parameters added) + -- being used to compile older versions of the compiler sources, as well as + -- avoiding duplicating values in all system-*.ads files for flags that are + -- used on a few platforms only. -- All these parameters should be regarded as read only by all clients -- of the package. The only way they get modified is by calling the |