diff options
96 files changed, 514 insertions, 1325 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0c84b93ff1d..8da2165e6ec 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,44 @@ 2014-08-01 Vincent Celier <celier@adacore.com> + * make.adb (Await_Compile): Remove loop that was only needed + for VMS. + +2014-08-01 Robert Dewar <dewar@adacore.com> + + * a-calcon.ads, a-direct.adb, a-dirval-mingw.adb, a-dirval.adb, + a-dirval.ads, a-except-2005.adb, a-excpol-abort.adb, + a-numaux-darwin.ads, a-numaux.ads, bindgen.adb, bindusg.adb, + einfo.adb, einfo.ads, err_vars.ads, errout.ads, errutil.adb, + exp_ch3.adb, exp_ch4.adb, exp_ch7.adb, exp_ch7.ads, fname-uf.adb, + fname.adb, fname.ads, freeze.adb, g-debpoo.adb, g-dirope.ads, + g-excact.ads, g-expect.ads, g-socket.adb, g-socket.ads, g-sothco.ads, + g-traceb.ads, gnat_rm.texi, gnatlink.adb, gnatls.adb, i-cstrea.adb, + krunch.adb, krunch.ads, layout.adb, lib-util.adb, make.adb, + mlib.adb, osint-b.adb, osint-b.ads, osint-c.adb, osint.adb, + osint.ads, output.ads, par.adb, prj-conf.adb, prj-env.adb, + prj-makr.adb, prj-nmsc.adb, prj.adb, prj.ads, repinfo.adb, rtsfind.adb, + rtsfind.ads, s-excmac-gcc.ads, s-fatgen.adb, s-mastop.ads, + s-parame-ae653.ads, s-parame-hpux.ads, s-parame-vxworks.ads, + s-parame.ads, s-soflin.ads, s-stoele.adb, s-tasini.adb, + s-taspri-dummy.ads, s-taspri-hpux-dce.ads, s-taspri-mingw.ads, + s-taspri-posix-noaltstack.ads, s-taspri-posix.ads, + s-taspri-solaris.ads, s-taspri-vxworks.ads, s-trasym.ads, + sem_ch12.adb, sem_ch4.adb, sem_eval.adb, sem_intr.adb, sem_mech.adb, + sem_mech.ads, sem_prag.adb, sem_res.adb, sem_util.adb, sem_util.ads, + sinfo.adb, sinfo.ads, sinput-c.adb, symbols.ads, targparm.adb, + treepr.adb, types.ads, xr_tabls.adb, xr_tabls.ads: Remove VMS + specific code and comments. + +2014-08-01 Ed Schonberg <schonberg@adacore.com> + + * sem_ch5.adb (Analyze_Iterator_Specification): New procedure + Check_Reverse_Iteration, to verify the legality of the Reverse + indicator on various container types, and to detect illegal + reverse iterations on containers that only supoort forward + iteration. + +2014-08-01 Vincent Celier <celier@adacore.com> + * gnatcmd.adb: Remove the VMS specific stuff. Integrate in procedure GNATCmd the relevant declarations from packages VMS_Cmds and VMS_Conv. diff --git a/gcc/ada/a-calcon.ads b/gcc/ada/a-calcon.ads index e478d508806..0fbf4a178aa 100644 --- a/gcc/ada/a-calcon.ads +++ b/gcc/ada/a-calcon.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2008-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 2008-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- -- @@ -37,11 +37,10 @@ with Interfaces.C; package Ada.Calendar.Conversions is function To_Ada_Time (Unix_Time : Interfaces.C.long) return Time; - -- Convert a time value represented as number of seconds since the Unix - -- Epoch to a time value relative to an Ada implementation-defined Epoch. - -- The units of the result are 100 nanoseconds on VMS and nanoseconds on - -- all other targets. Raises Time_Error if the result cannot fit into a - -- Time value. + -- Convert a time value represented as number of seconds since the + -- Unix Epoch to a time value relative to an Ada implementation-defined + -- Epoch. The units of the result are nanoseconds on all targets. Raises + -- Time_Error if the result cannot fit into a Time value. function To_Ada_Time (tm_year : Interfaces.C.int; diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index 20fd064fe80..f567984a679 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -982,7 +982,6 @@ package body Ada.Directories is Hour : Hour_Type; Minute : Minute_Type; Second : Second_Type; - Result : Time; begin -- First, the invalid cases @@ -999,25 +998,11 @@ package body Ada.Directories is GM_Split (Date, Year, Month, Day, Hour, Minute, Second); - -- On OpenVMS, the resulting time value must be in the local time - -- zone. Ada.Calendar.Time_Of is exactly what we need. Note that - -- in both cases, the sub seconds are set to zero (0.0) because the - -- time stamp does not store them in its value. - - if OpenVMS then - Result := - Ada.Calendar.Time_Of - (Year, Month, Day, Seconds_Of (Hour, Minute, Second, 0.0)); - - -- On Unix and Windows, the result must be in GMT. Ada.Calendar. + -- The result must be in GMT. Ada.Calendar. -- Formatting.Time_Of with default time zone of zero (0) is the -- routine of choice. - else - Result := Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0); - end if; - - return Result; + return Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0); end if; end Modification_Time; diff --git a/gcc/ada/a-dirval-mingw.adb b/gcc/ada/a-dirval-mingw.adb index 205f128cdaf..d7d77622db7 100644 --- a/gcc/ada/a-dirval-mingw.adb +++ b/gcc/ada/a-dirval-mingw.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Windows Version) -- -- -- --- Copyright (C) 2004-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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- -- @@ -162,15 +162,6 @@ package body Ada.Directories.Validity is end Is_Valid_Simple_Name; ------------- - -- OpenVMS -- - ------------- - - function OpenVMS return Boolean is - begin - return False; - end OpenVMS; - - ------------- -- Windows -- ------------- diff --git a/gcc/ada/a-dirval.adb b/gcc/ada/a-dirval.adb index c3da2efd437..7a08500a232 100644 --- a/gcc/ada/a-dirval.adb +++ b/gcc/ada/a-dirval.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (POSIX Version) -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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- -- @@ -93,15 +93,6 @@ package body Ada.Directories.Validity is end Is_Valid_Simple_Name; ------------- - -- OpenVMS -- - ------------- - - function OpenVMS return Boolean is - begin - return False; - end OpenVMS; - - ------------- -- Windows -- ------------- diff --git a/gcc/ada/a-dirval.ads b/gcc/ada/a-dirval.ads index f7b2bb6728c..9505dffd6fa 100644 --- a/gcc/ada/a-dirval.ads +++ b/gcc/ada/a-dirval.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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- -- @@ -43,9 +43,6 @@ private package Ada.Directories.Validity is function Is_Path_Name_Case_Sensitive return Boolean; -- Returns True if file and path names are case-sensitive - function OpenVMS return Boolean; - -- Return True when OS is OpenVMS - function Windows return Boolean; -- Return True when OS is Windows diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index db97068e9c9..0b33c0c9f3f 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -672,24 +672,23 @@ package body Ada.Exceptions is -- perform periodic but not systematic operations. procedure Poll is separate; - -- The actual polling routine is separate, so that it can easily - -- be replaced with a target dependent version. + -- The actual polling routine is separate, so that it can easily be + -- replaced with a target dependent version. -------------------------- -- Code_Address_For_AAA -- -------------------------- - -- This function gives us the start of the PC range for addresses - -- within the exception unit itself. We hope that gigi/gcc keep all the - -- procedures in their original order. + -- This function gives us the start of the PC range for addresses within + -- the exception unit itself. We hope that gigi/gcc keep all the procedures + -- in their original order. function Code_Address_For_AAA return System.Address is begin - -- We are using a label instead of merely using - -- Code_Address_For_AAA'Address because on some platforms the latter - -- does not yield the address we want, but the address of a stub or of - -- a descriptor instead. This is the case at least on Alpha-VMS and - -- PA-HPUX. + -- We are using a label instead of Code_Address_For_AAA'Address because + -- on some platforms the latter does not yield the address we want, but + -- the address of a stub or of a descriptor instead. This is the case at + -- least on PA-HPUX. <<Start_Of_AAA>> return Start_Of_AAA'Address; diff --git a/gcc/ada/a-excpol-abort.adb b/gcc/ada/a-excpol-abort.adb index ebfc1a0b4d4..d4f9a078657 100644 --- a/gcc/ada/a-excpol-abort.adb +++ b/gcc/ada/a-excpol-abort.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -35,7 +35,7 @@ -- that activates periodic polling. Then in the body of the polling routine -- we test for asynchronous abort. --- Windows, HPUX 10 and VMS currently use this file +-- Windows and HPUX 10 currently use this file pragma Warnings (Off); -- Allow withing of non-Preelaborated units in Ada 2005 mode where this diff --git a/gcc/ada/a-numaux-darwin.ads b/gcc/ada/a-numaux-darwin.ads index 4164f512d12..2f58ed83866 100644 --- a/gcc/ada/a-numaux-darwin.ads +++ b/gcc/ada/a-numaux-darwin.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (Apple OS X Version) -- -- -- --- 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- -- @@ -31,12 +31,11 @@ ------------------------------------------------------------------------------ -- 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 OpenVMS (different import names), 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). +-- 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). package Ada.Numerics.Aux is pragma Pure; diff --git a/gcc/ada/a-numaux.ads b/gcc/ada/a-numaux.ads index cef530183f5..7f265dd043e 100644 --- a/gcc/ada/a-numaux.ads +++ b/gcc/ada/a-numaux.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (C Library Version, non-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- -- @@ -37,11 +37,10 @@ -- One advantage of using this package is that it will interface directly to -- hardware instructions, such as the those provided on the Intel x86. --- This version is for use with normal Unix math functions. Alternative --- packages are used on OpenVMS (different import names), 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 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). package Ada.Numerics.Aux is pragma Pure; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 553542ef529..a1bb7646ba0 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -159,12 +159,9 @@ package body Bindgen is -- A value of zero indicates that time slicing should be suppressed. If no -- pragma is present, and no -T switch was used, the value is -1. - -- Heap_Size is the heap to use for memory allocations set by use of a - -- -Hnn parameter for the binder or by the GNAT$NO_MALLOC_64 logical. - -- Valid values are 32 and 64. This switch is only effective on VMS. - - -- Float_Format is the float representation in use. Valid values are - -- 'I' for IEEE and 'V' for VAX Float. This is only for VMS. + -- Float_Format is the float representation in use. Currently the only + -- valid value is 'I' for IEEE. We needed this field in the past for other + -- floating-point formats, and it is retained for possible future use. -- WC_Encoding shows the wide character encoding method used for the main -- program. This is one of the encoding letters defined in @@ -2046,10 +2043,10 @@ package body Bindgen is -- files. The reason for this decision is that libraries referenced -- by internal routines may reference these standard library entries. - -- Note that we do not insert anything when pragma No_Run_Time has been - -- specified or when the standard libraries are not to be used, - -- otherwise on some platforms, such as VMS, we may get duplicate - -- symbols when linking. + -- Note that we do not insert anything when pragma No_Run_Time has + -- been specified or when the standard libraries are not to be used, + -- otherwise on some platforms, we may get duplicate symbols when + -- linking (not clear if this is still the case, but it is harmless). if not (Opt.No_Run_Time_Mode or else Opt.No_Stdlib) then Name_Len := 0; @@ -2212,8 +2209,7 @@ package body Bindgen is Resolve_Binder_Options; - -- Usually, adafinal is called using a pragma Import C. Since Import C - -- doesn't have the same semantics for VMs or CodePeer use standard Ada. + -- Generate standard with's if not Suppress_Standard_Library_On_Target then if CodePeer_Mode then diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index e9d39504af1..b1029487dfa 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, 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- -- @@ -120,11 +120,6 @@ package body Bindusg is Write_Line (" -h Output this usage (help) information"); - -- Line for -H switch - - Write_Line (" -Hnn Use nn bit heap where nn is 32 or 64 " & - "(VMS Only)"); - -- Lines for -I switch Write_Line (" -Idir Specify library and source files search path"); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 0c229a723b9..37a323ac141 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -411,7 +411,6 @@ package body Einfo is -- Is_Generic_Instance Flag130 -- No_Pool_Assigned Flag131 - -- Is_Optional_Parameter Flag134 -- Has_Aliased_Components Flag135 -- No_Strict_Aliasing Flag136 -- Is_Machine_Code_Subprogram Flag137 @@ -573,6 +572,12 @@ package body Einfo is -- (unused) Flag2 -- (unused) Flag3 + -- (unused) Flag132 + -- (unused) Flag133 + -- (unused) Flag134 + + -- (unused) Flag275 + -- (unused) Flag276 -- (unused) Flag277 -- (unused) Flag278 -- (unused) Flag279 @@ -2202,12 +2207,6 @@ package body Einfo is return Flag226 (Id); end Is_Only_Out_Parameter; - function Is_Optional_Parameter (Id : E) return B is - begin - pragma Assert (Is_Formal (Id)); - return Flag134 (Id); - end Is_Optional_Parameter; - function Is_Package_Body_Entity (Id : E) return B is begin return Flag160 (Id); @@ -4993,12 +4992,6 @@ package body Einfo is Set_Flag226 (Id, V); end Set_Is_Only_Out_Parameter; - procedure Set_Is_Optional_Parameter (Id : E; V : B := True) is - begin - pragma Assert (Is_Formal (Id)); - Set_Flag134 (Id, V); - end Set_Is_Optional_Parameter; - procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is begin Set_Flag160 (Id, V); @@ -8405,7 +8398,6 @@ package body Einfo is W ("Is_Null_Init_Proc", Flag178 (Id)); W ("Is_Obsolescent", Flag153 (Id)); W ("Is_Only_Out_Parameter", Flag226 (Id)); - W ("Is_Optional_Parameter", Flag134 (Id)); W ("Is_Package_Body_Entity", Flag160 (Id)); W ("Is_Packed", Flag51 (Id)); W ("Is_Packed_Array_Impl_Type", Flag138 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c8dd25bf4ac..de4b617bece 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2328,7 +2328,7 @@ package Einfo is -- Defined in all entities. Set if the entity is exported. For now we -- only allow the export of constants, exceptions, functions, procedures -- and variables, but that may well change later on. Exceptions can only --- be exported in the OpenVMS and Java VM implementations of GNAT. +-- be exported in the Java VM implementation of GNAT. -- Is_External_State (synthesized) -- Applies to all entities, true for abstract states that are subject to @@ -2447,9 +2447,8 @@ package Einfo is -- Is_Imported (Flag24) -- Defined in all entities. Set if the entity is imported. For now we -- only allow the import of exceptions, functions, procedures, packages. --- and variables. Exceptions can only be imported in the OpenVMS and --- Java VM implementations of GNAT. Packages and types can only be --- imported in the Java VM implementation. +-- and variables. Exceptions, packages and types can only be imported in +-- the Java VM implementation. -- Is_Incomplete_Or_Private_Type (synthesized) -- Applies to all entities, true for private and incomplete types @@ -2697,11 +2696,6 @@ package Einfo is -- out parameter, or if there is some other IN OUT parameter then this -- flag is not set in any of them. Used in generation of warnings. --- Is_Optional_Parameter (Flag134) --- Defined in parameter entities. Set if the parameter is specified as --- optional by use of a First_Optional_Parameter argument to one of the --- extended Import pragmas. Can only be set for OpenVMS versions of GNAT. - -- Is_Ordinary_Fixed_Point_Type (synthesized) -- Applies to all entities, true for ordinary fixed point types and -- subtypes. @@ -3348,8 +3342,9 @@ package Einfo is -- types which have a convention of C, C++ or Fortran. -- No_Dynamic_Predicate_On_Actual (Flag276) --- Defined on generic formal types that are used in loops and quantified --- expressions. The corresponing actual cannot have dynamic predicates. +-- Defined in discrete types. Set for generic formal types that are used +-- in loops and quantified expressions. The corresponing actual cannot +-- have dynamic predicates. -- No_Pool_Assigned (Flag131) [root type only] -- Defined in access types. Set if a storage size clause applies to the @@ -3359,8 +3354,9 @@ package Einfo is -- derived types must have the same pool. -- No_Predicate_On_Actual (Flag275) --- Defined on generic formal types that are used in the spec of a generic --- package, in constructs that forbid discrete types with predicates. +-- Defined in discrete types. Set for generic formal types that are used +-- in the spec of a generic package, in constructs that forbid discrete +-- types with predicates. -- No_Return (Flag113) -- Defined in all entities. Always false except in the case of procedures @@ -5751,7 +5747,6 @@ package Einfo is -- Has_Initial_Value (Flag219) -- Is_Controlling_Formal (Flag97) -- Is_Only_Out_Parameter (Flag226) - -- Is_Optional_Parameter (Flag134) -- Low_Bound_Tested (Flag205) -- Is_Return_Object (Flag209) -- Parameter_Mode (synth) @@ -6703,7 +6698,6 @@ package Einfo is function Is_Null_Init_Proc (Id : E) return B; function Is_Obsolescent (Id : E) return B; function Is_Only_Out_Parameter (Id : E) return B; - function Is_Optional_Parameter (Id : E) return B; function Is_Package_Body_Entity (Id : E) return B; function Is_Packed (Id : E) return B; function Is_Packed_Array_Impl_Type (Id : E) return B; @@ -7343,7 +7337,6 @@ package Einfo is procedure Set_Is_Null_Init_Proc (Id : E; V : B := True); procedure Set_Is_Obsolescent (Id : E; V : B := True); procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True); - procedure Set_Is_Optional_Parameter (Id : E; V : B := True); procedure Set_Is_Package_Body_Entity (Id : E; V : B := True); procedure Set_Is_Packed (Id : E; V : B := True); procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True); @@ -8119,7 +8112,6 @@ package Einfo is pragma Inline (Is_Object); pragma Inline (Is_Obsolescent); pragma Inline (Is_Only_Out_Parameter); - pragma Inline (Is_Optional_Parameter); pragma Inline (Is_Ordinary_Fixed_Point_Type); pragma Inline (Is_Overloadable); pragma Inline (Is_Package_Body_Entity); @@ -8570,7 +8562,6 @@ package Einfo is pragma Inline (Set_Is_Null_Init_Proc); pragma Inline (Set_Is_Obsolescent); pragma Inline (Set_Is_Only_Out_Parameter); - pragma Inline (Set_Is_Optional_Parameter); pragma Inline (Set_Is_Package_Body_Entity); pragma Inline (Set_Is_Packed); pragma Inline (Set_Is_Packed_Array_Impl_Type); diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 6009379c0a2..48e382df0c0 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.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- -- @@ -93,7 +93,6 @@ package Err_Vars is -- are active (see errout.ads for details). If this switch is False, then -- these sequences are ignored (i.e. simply equivalent to a single ?). The -- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False. - -- Note: always ignored on VMS, where we do not provide this capability. ---------------------------------------- -- Error Message Insertion Parameters -- diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 19931e83236..eaed2aa4cba 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -413,68 +413,6 @@ package Errout is -- are continuations that are not printed using the -gnatj switch they -- will also have this prefix. - ---------------------------------------- - -- Specialization of Messages for VMS -- - ---------------------------------------- - - -- Some messages mention gcc-style switch names. When using an OpenVMS - -- host, such switch names must be converted to their corresponding VMS - -- qualifer. The following table controls this translation. In each case - -- the original message must contain the string "-xxx switch", where xxx - -- is the Gname? entry from below, and this string will be replaced by - -- "/yyy qualifier", where yyy is the corresponding Vname? entry. - - Gname1 : aliased constant String := "fno-strict-aliasing"; - Vname1 : aliased constant String := "OPTIMIZE=NO_STRICT_ALIASING"; - - Gname2 : aliased constant String := "gnatX"; - Vname2 : aliased constant String := "EXTENSIONS_ALLOWED"; - - Gname3 : aliased constant String := "gnatW"; - Vname3 : aliased constant String := "WIDE_CHARACTER_ENCODING"; - - Gname4 : aliased constant String := "gnatf"; - Vname4 : aliased constant String := "REPORT_ERRORS=FULL"; - - Gname5 : aliased constant String := "gnat05"; - Vname5 : aliased constant String := "05"; - - Gname6 : aliased constant String := "gnat2005"; - Vname6 : aliased constant String := "2005"; - - Gname7 : aliased constant String := "gnat12"; - Vname7 : aliased constant String := "12"; - - Gname8 : aliased constant String := "gnat2012"; - Vname8 : aliased constant String := "2012"; - - Gname9 : aliased constant String := "gnateinn"; - Vname9 : aliased constant String := "MAX_INSTANTIATIONS=nn"; - - type Cstring_Ptr is access constant String; - - Gnames : array (Nat range <>) of Cstring_Ptr := - (Gname1'Access, - Gname2'Access, - Gname3'Access, - Gname4'Access, - Gname5'Access, - Gname6'Access, - Gname7'Access, - Gname8'Access, - Gname9'Access); - - Vnames : array (Nat range <>) of Cstring_Ptr := - (Vname1'Access, - Vname2'Access, - Vname3'Access, - Vname4'Access, - Vname5'Access, - Vname6'Access, - Vname7'Access, - Vname8'Access, - Vname9'Access); - ----------------------------------------------------- -- Global Values Used for Error Message Insertions -- ----------------------------------------------------- diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb index 4121ba983b9..0c47f2183c4 100644 --- a/gcc/ada/errutil.adb +++ b/gcc/ada/errutil.adb @@ -502,10 +502,10 @@ package body Errutil is -- error to make sure that *something* appears on standard error in -- an error situation. - -- Formerly, only the "# errors" suffix was sent to stderr, whereas - -- "# lines:" appeared on stdout. This caused problems on VMS when - -- the stdout buffer was flushed, giving an extra line feed after - -- the prefix. + -- Historical note: Formerly, only the "# errors" suffix was sent + -- to stderr, whereas "# lines:" appeared on stdout. This caused + -- some problems on now-obsolete ports, but there seems to be no + -- reason to revert this page since it would be incompatible. if Total_Errors_Detected + Warnings_Detected /= 0 and then not Brief_Output diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5d5edf3bf78..7774d09f3c2 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1701,18 +1701,6 @@ package body Exp_Ch3 is end if; end if; - -- When the object is either protected or a task, create static strings - -- which denote the names of entries and families. Associate the strings - -- with the concurrent object's Protection_Entries or ATCB. This is a - -- VMS Debug feature. - - if OpenVMS_On_Target - and then Is_Concurrent_Type (Typ) - and then Entry_Names_OK - then - Build_Entry_Names (Id_Ref, Typ, Res); - end if; - return Res; exception @@ -7212,8 +7200,8 @@ package body Exp_Ch3 is -- All anonymous access-to-controlled types allocate -- on the global pool. - Set_Associated_Storage_Pool (Comp_Typ, - Get_Global_Pool_For_Access_Type (Comp_Typ)); + Set_Associated_Storage_Pool + (Comp_Typ, RTE (RE_Global_Pool_Object)); Build_Finalization_Master (Typ => Comp_Typ, @@ -7229,8 +7217,8 @@ package body Exp_Ch3 is -- All anonymous access-to-controlled types allocate -- on the global pool. - Set_Associated_Storage_Pool (Comp_Typ, - Get_Global_Pool_For_Access_Type (Comp_Typ)); + Set_Associated_Storage_Pool + (Comp_Typ, RTE (RE_Global_Pool_Object)); -- Shared the master among multiple components diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index dca3ec18776..11833e5b68d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4313,11 +4313,11 @@ package body Exp_Ch4 is if No (Associated_Storage_Pool (PtrT)) and then VM_Target = No_VM then if Present (Rel_Typ) then - Set_Associated_Storage_Pool (PtrT, - Associated_Storage_Pool (Rel_Typ)); + Set_Associated_Storage_Pool + (PtrT, Associated_Storage_Pool (Rel_Typ)); else - Set_Associated_Storage_Pool (PtrT, - Get_Global_Pool_For_Access_Type (PtrT)); + Set_Associated_Storage_Pool + (PtrT, RTE (RE_Global_Pool_Object)); end if; end if; @@ -8537,17 +8537,18 @@ package body Exp_Ch4 is --------------------- -- If the argument is other than a Boolean array type, there is no special - -- expansion required, except for VMS operations on signed integers. + -- expansion required, except for dealing with validity checks, and non- + -- standard boolean representations. - -- For the packed case, we call the special routine in Exp_Pakd, except - -- that if the component size is greater than one, we use the standard - -- routine generating a gruesome loop (it is so peculiar to have packed - -- arrays with non-standard Boolean representations anyway, so it does not - -- matter that we do not handle this case efficiently). + -- For the packed array case, we call the special routine in Exp_Pakd, + -- except that if the component size is greater than one, we use the + -- standard routine generating a gruesome loop (it is so peculiar to have + -- packed arrays with non-standard Boolean representations anyway, so it + -- does not matter that we do not handle this case efficiently). - -- For the unpacked case (and for the special packed case where we have non - -- standard Booleans, as discussed above), we generate and insert into the - -- tree the following function definition: + -- For the unpacked array case (and for the special packed case where we + -- have non standard Booleans, as discussed above), we generate and insert + -- into the tree the following function definition: -- function Nnnn (A : arr) is -- B : arr; @@ -8587,49 +8588,6 @@ package body Exp_Ch4 is return; end if; - -- For the VMS "not" on signed integer types, use conversion to and from - -- a predefined modular type. - - if Is_VMS_Operator (Entity (N)) then - declare - Rtyp : Entity_Id; - Utyp : Entity_Id; - - begin - -- If this is a derived type, retrieve original VMS type so that - -- the proper sized type is used for intermediate values. - - if Is_Derived_Type (Typ) then - Rtyp := First_Subtype (Etype (Typ)); - else - Rtyp := Typ; - end if; - - -- The proper unsigned type must have a size compatible with the - -- operand, to prevent misalignment. - - if RM_Size (Rtyp) <= 8 then - Utyp := RTE (RE_Unsigned_8); - - elsif RM_Size (Rtyp) <= 16 then - Utyp := RTE (RE_Unsigned_16); - - elsif RM_Size (Rtyp) = RM_Size (Standard_Unsigned) then - Utyp := RTE (RE_Unsigned_32); - - else - Utyp := RTE (RE_Long_Long_Unsigned); - end if; - - Rewrite (N, - Unchecked_Convert_To (Typ, - Make_Op_Not (Loc, - Unchecked_Convert_To (Utyp, Right_Opnd (N))))); - Analyze_And_Resolve (N, Typ); - return; - end; - end if; - -- Only array types need any other processing if not Is_Array_Type (Typ) then diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 00fd3e09375..7d1526ca8c9 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -936,7 +936,7 @@ package body Exp_Ch7 is -- The default choice is the global pool else - Pool_Id := Get_Global_Pool_For_Access_Type (Ptr_Typ); + Pool_Id := RTE (RE_Global_Pool_Object); Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id); end if; @@ -4486,25 +4486,6 @@ package body Exp_Ch7 is end loop; end Find_Node_To_Be_Wrapped; - ------------------------------------- - -- Get_Global_Pool_For_Access_Type -- - ------------------------------------- - - function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id is - begin - -- Access types whose size is smaller than System.Address size can exist - -- only on VMS. We can't use the usual global pool which returns an - -- object of type Address as truncation will make it invalid. To handle - -- this case, VMS has a dedicated global pool that returns addresses - -- that fit into 32 bit accesses. - - if Opt.True_VMS_Target and then Esize (T) = 32 then - return RTE (RE_Global_Pool_32_Object); - else - return RTE (RE_Global_Pool_Object); - end if; - end Get_Global_Pool_For_Access_Type; - ---------------------------------- -- Has_New_Controlled_Component -- ---------------------------------- diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 1217e5b5f3b..ee24e6d6d55 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -151,11 +151,6 @@ package Exp_Ch7 is -- when pragma Restrictions (No_Finalization) applies, in which case we -- know that class-wide objects do not contain controlled parts. - function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id; - -- Return the pool id for access type T. This is generally the node - -- corresponding to System.Global_Pool.Global_Pool_Object except on - -- VMS if the access size is 32. - function Has_New_Controlled_Component (E : Entity_Id) return Boolean; -- E is a type entity. Give the same result as Has_Controlled_Component -- except for tagged extensions where the result is True only if the diff --git a/gcc/ada/fname-uf.adb b/gcc/ada/fname-uf.adb index e3a731fefae..7bf27dbe22b 100644 --- a/gcc/ada/fname-uf.adb +++ b/gcc/ada/fname-uf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, 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,7 +30,6 @@ with Krunch; with Opt; use Opt; with Osint; use Osint; with Table; -with Targparm; use Targparm; with Uname; use Uname; with Widechar; use Widechar; @@ -410,8 +409,7 @@ package body Fname.UF is (Name_Buffer, Name_Len, Integer (Maximum_File_Name_Length), - Debug_Flag_4, - OpenVMS_On_Target); + Debug_Flag_4); -- Replace extension diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 48cb207054c..0bea5a0ba18 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, 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,9 +30,8 @@ ------------------------------------------------------------------------------ with Alloc; -with Hostparm; use Hostparm; with Table; -with Types; use Types; +with Types; use Types; package body Fname is @@ -78,13 +77,6 @@ package body Fname is then return True; - elsif OpenVMS - and then - (Name_Buffer (1 .. 4) = "dec-" - or else Name_Buffer (1 .. 8) = "dec ") - then - return True; - else return False; end if; diff --git a/gcc/ada/fname.ads b/gcc/ada/fname.ads index 74523c098ee..79c84c6cc8a 100644 --- a/gcc/ada/fname.ads +++ b/gcc/ada/fname.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, 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- -- @@ -83,8 +83,7 @@ package Fname is (Fname : File_Name_Type; Renamings_Included : Boolean := True) return Boolean; -- Similar to Is_Predefined_File_Name. The internal file set is a superset - -- of the predefined file set including children of GNAT, and also children - -- of DEC for the VMS case. + -- of the predefined file set including children of GNAT. procedure Tree_Read; -- Dummy procedure (reads dummy table values from tree file) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5b82ae4a946..190813019a5 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -7038,11 +7038,7 @@ package body Freeze is else Set_Mechanisms (E); - -- For foreign conventions, warn about return of an - -- unconstrained array. - - -- Note: we *do* allow a return by descriptor for the VMS case, - -- though here there is probably more to be done ??? + -- For foreign conventions, warn about return of unconstrained array if Ekind (E) = E_Function then Retype := Underlying_Type (Etype (E)); @@ -7065,11 +7061,6 @@ package body Freeze is elsif Is_Array_Type (Retype) and then not Is_Constrained (Retype) - -- Exclude cases where descriptor mechanism is set, since the - -- VMS descriptor mechanisms allow such unconstrained returns. - - and then Mechanism (E) not in Descriptor_Codes - -- Check appropriate warning is enabled (should we check for -- Warnings (Off) on specific entities here, probably so???) @@ -7107,39 +7098,6 @@ package body Freeze is end if; end if; - -- For VMS, descriptor mechanisms for parameters are allowed only for - -- imported/exported subprograms. Moreover, the NCA descriptor is not - -- allowed for parameters of exported subprograms. - - if OpenVMS_On_Target then - if Is_Exported (E) then - F := First_Formal (E); - while Present (F) loop - if Mechanism (F) = By_Descriptor_NCA then - Error_Msg_N - ("'N'C'A' descriptor for parameter not permitted", F); - Error_Msg_N - ("\can only be used for imported subprogram", F); - end if; - - Next_Formal (F); - end loop; - - elsif not Is_Imported (E) then - F := First_Formal (E); - while Present (F) loop - if Mechanism (F) in Descriptor_Codes then - Error_Msg_N - ("descriptor mechanism for parameter not permitted", F); - Error_Msg_N - ("\can only be used for imported/exported subprogram", F); - end if; - - Next_Formal (F); - end loop; - end if; - end if; - -- Pragma Inline_Always is disallowed for dispatching subprograms -- because the address of such subprograms is saved in the dispatch -- table to support dispatching calls, and dispatching calls cannot diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb index db17fa408ca..8d4372f6deb 100644 --- a/gcc/ada/g-debpoo.adb +++ b/gcc/ada/g-debpoo.adb @@ -305,8 +305,8 @@ package body GNAT.Debug_Pools is Code_Address_For_Deallocate_End : System.Address; Code_Address_For_Dereference_End : System.Address; -- Taking the address of the above procedures will not work on some - -- architectures (HPUX and VMS for instance). Thus we do the same thing - -- that is done in a-except.adb, and get the address of labels instead + -- architectures (HPUX for instance). Thus we do the same thing that + -- is done in a-except.adb, and get the address of labels instead. procedure Skip_Levels (Depth : Natural; diff --git a/gcc/ada/g-dirope.ads b/gcc/ada/g-dirope.ads index 51d449d0481..fe02d3fd136 100644 --- a/gcc/ada/g-dirope.ads +++ b/gcc/ada/g-dirope.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2010, AdaCore -- +-- Copyright (C) 1998-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- -- @@ -37,10 +37,6 @@ -- See also child package GNAT.Directory_Operations.Iteration --- Note: support on OpenVMS is limited to the support of Unix-style --- directory names (OpenVMS native directory format is not supported). --- Read individual entries for more specific notes on OpenVMS support. - with System; with Ada.Strings.Maps; @@ -54,8 +50,6 @@ package GNAT.Directory_Operations is -- '\' character. It can also include drive letters if the operating -- system provides for this. The final '/' or '\' in a Dir_Name_Str is -- optional when passed as a procedure or function in parameter. - -- On OpenVMS, only Unix style path names are supported, not VMS style, - -- but the directory and file names are not case sensitive. type Dir_Type is limited private; -- A value used to reference a directory. Conceptually this value includes @@ -117,7 +111,7 @@ package GNAT.Directory_Operations is -- returned. Note that the contents of Path is case-sensitive on -- systems that have case-sensitive file names (like Unix), and -- non-case-sensitive on systems where the file system is also non- - -- case-sensitive (such as Windows, and OpenVMS). + -- case-sensitive (such as Windows). function Base_Name (Path : Path_Name; @@ -133,8 +127,8 @@ package GNAT.Directory_Operations is -- 'Path' and 'Dir_Name (Path) & Dir_Separator & Base_Name (Path)' -- represent the same file. -- - -- The comparison of Suffix is case-insensitive on systems such as Windows - -- and VMS where the file search is case-insensitive (e.g. on such systems, + -- The comparison of Suffix is case-insensitive on systems like Windows + -- where the file search is case-insensitive (e.g. on such systems, -- Base_Name ("/Users/AdaCore/BB12.patch", ".Patch") returns "BB12"). -- -- Note that the index bounds of the result match the corresponding indexes @@ -165,12 +159,11 @@ package GNAT.Directory_Operations is -- -- The Style argument indicates the syntax to be used for path names: -- - -- UNIX - -- Use '/' as the directory separator. The default on Unix systems - -- and on OpenVMS. - -- -- DOS - -- Use '\' as the directory separator. The default on Windows. + -- Use '\' as the directory separator (default on Windows) + -- + -- UNIX + -- Use '/' as the directory separator (default on all other systems) -- -- System_Default -- Use the default style for the current system @@ -179,24 +172,24 @@ package GNAT.Directory_Operations is function Expand_Path (Path : Path_Name; Mode : Environment_Style := System_Default) return Path_Name; - -- Returns Path with environment variables (or logical names on OpenVMS) - -- replaced by the current environment variable value. For example, - -- $HOME/mydir will be replaced by /home/joe/mydir if $HOME environment - -- variable is set to /home/joe and Mode is UNIX. If an environment - -- variable does not exists the variable will be replaced by the empty - -- string. Two dollar or percent signs are replaced by a single - -- dollar/percent sign. Note that a variable must start with a letter. + -- Returns Path with environment variables replaced by the current + -- environment variable value. For example, $HOME/mydir will be replaced + -- by /home/joe/mydir if $HOME environment variable is set to /home/joe and + -- Mode is UNIX. If an environment variable does not exists the variable + -- will be replaced by the empty string. Two dollar or percent signs are + -- replaced by a single dollar/percent sign. Note that a variable must + -- start with a letter. -- -- The Mode argument indicates the recognized syntax for environment -- variables as follows: -- -- UNIX - -- Environment variables and OpenVMS logical names use $ as prefix and - -- can use curly brackets as in ${HOME}/mydir. If there is no closing - -- curly bracket for an opening one then no translation is done, so for - -- example ${VAR/toto is returned as ${VAR/toto. The use of {} brackets - -- is required if the environment variable name contains other than - -- alphanumeric characters. + -- Environment variables use $ as prefix and can use curly brackets + -- as in ${HOME}/mydir. If there is no closing curly bracket for an + -- opening one then no translation is done, so for example ${VAR/toto + -- is returned as ${VAR/toto. The use of {} brackets is required if + -- the environment variable name contains other than alphanumeric + -- characters. -- -- DOS -- Environment variables uses % as prefix and suffix (e.g. %HOME%/dir). @@ -207,8 +200,8 @@ package GNAT.Directory_Operations is -- Recognize both forms described above. -- -- System_Default - -- Uses either UNIX on Unix and OpenVMS systems, or DOS on Windows, - -- depending on the running environment. What about other OS's??? + -- Uses either DOS on Windows, and UNIX on all other systems, depending + -- on the running environment. --------------- -- Iterators -- diff --git a/gcc/ada/g-excact.ads b/gcc/ada/g-excact.ads index 6111bc7fd02..44f067ddbb7 100644 --- a/gcc/ada/g-excact.ads +++ b/gcc/ada/g-excact.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- @@ -111,8 +111,8 @@ package GNAT.Exception_Actions is procedure Core_Dump (Occurrence : Exception_Occurrence); -- Dump memory (called a core dump in some systems) if supported by the - -- OS (most unix systems and VMS), and abort execution of the application. - -- Under Windows this procedure will not dump the memory, it will only - -- abort execution. + -- OS (most unix systems), and abort execution of the application. Under + -- Windows this procedure will not dump the memory, it will only abort + -- execution. end GNAT.Exception_Actions; diff --git a/gcc/ada/g-expect.ads b/gcc/ada/g-expect.ads index 22b84ca00f3..8c4ab48b5c6 100644 --- a/gcc/ada/g-expect.ads +++ b/gcc/ada/g-expect.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2010, AdaCore -- +-- Copyright (C) 2000-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- -- @@ -29,9 +29,9 @@ -- -- ------------------------------------------------------------------------------ --- Currently this package is implemented on all native GNAT ports except --- for VMS. It is not yet implemented for any of the cross-ports (e.g. it --- is not available for VxWorks or LynxOS). +-- Currently this package is implemented on all native GNAT ports. It is not +-- yet implemented for any of the cross-ports (e.g. it is not available for +-- VxWorks or LynxOS). -- ----------- -- -- Usage -- diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index b70c2cf2028..94125173515 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -172,8 +172,7 @@ package body GNAT.Sockets is -- Conversion function function Value (S : System.Address) return String; - -- Same as Interfaces.C.Strings.Value but taking a System.Address (on VMS, - -- chars_ptr is a 32-bit pointer, and here we need a 64-bit version). + -- Same as Interfaces.C.Strings.Value but taking a System.Address function To_Timeval (Val : Timeval_Duration) return Timeval; -- Separate Val in seconds and microseconds diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index d93536cb26b..517dd4f510a 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -39,9 +39,6 @@ -- feature, so it is not available if Multicast is not supported, or not -- installed. --- The VMS implementation was implemented using the DECC RTL Socket API, --- and is thus subject to limitations in the implementation of this API. - -- VxWorks cross ports fully implement this package -- This package is not yet implemented on LynxOS or other cross ports diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads index b957f225e80..0d77dd75ef9 100644 --- a/gcc/ada/g-sothco.ads +++ b/gcc/ada/g-sothco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2008-2012, AdaCore -- +-- Copyright (C) 2008-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- -- @@ -212,11 +212,6 @@ package GNAT.Sockets.Thin_Common is pragma Convention (C, Hostent_Access); -- Access to host entry - -- Note: the hostent and servent accessors that return char* - -- values are compiled with GCC, and on VMS they always return - -- 64-bit pointers, so we can't use C.Strings.chars_ptr, which - -- on VMS is 32 bits. - function Hostent_H_Name (E : Hostent_Access) return System.Address; diff --git a/gcc/ada/g-traceb.ads b/gcc/ada/g-traceb.ads index debb0c40341..98d11a8ef99 100644 --- a/gcc/ada/g-traceb.ads +++ b/gcc/ada/g-traceb.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2012, AdaCore -- +-- Copyright (C) 1999-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- -- @@ -63,8 +63,6 @@ -- LynxOS x86 -- Solaris x86 -- Solaris sparc --- OpenVMS/Alpha --- OpenVMS/ia64 -- VxWorks PowerPC -- VxWorks x86 -- Windows NT/XP diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index d936cdb1d6b..e29a29d5007 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -3633,10 +3633,6 @@ MECHANISM_ASSOCIATION ::= MECHANISM_NAME ::= Value | Reference -| Descriptor [([Class =>] CLASS_NAME)] -| Short_Descriptor [([Class =>] CLASS_NAME)] - -CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca @end smallexample @noindent @@ -3665,21 +3661,6 @@ parameter by parameter basis using either positional or named notation. If the mechanism is not specified, the default mechanism is used. -@cindex OpenVMS -@cindex Passing by descriptor -Passing by descriptor is supported only on the OpenVMS ports of GNAT@. -The default behavior for Import_Function is to pass a 64bit descriptor -unless short_descriptor is specified, then a 32bit descriptor is passed. - -@code{First_Optional_Parameter} applies only to OpenVMS ports of GNAT@. -It specifies that the designated parameter and all following parameters -are optional, meaning that they are not passed at the generated code -level (this is distinct from the notion of optional parameters in Ada -where the parameters are passed anyway with the designated optional -parameters). All optional parameters must be of mode @code{IN} and have -default parameter values that are either known at compile time -expressions, or uses of the @code{'Null_Parameter} attribute. - @node Pragma Import_Object @unnumberedsec Pragma Import_Object @findex Import_Object @@ -3739,13 +3720,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 | nca +MECHANISM_NAME ::= Value | Reference @end smallexample @noindent @@ -3786,14 +3761,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 | nca -@end smallexample +MECHANISM_NAME ::= Value | Reference @noindent This pragma is identical to @code{Import_Procedure} except that the @@ -9260,28 +9228,8 @@ meaning the first parameter) of @var{subprogram}. The code returned is: by copy (value) @item 2 by reference -@item 3 -by descriptor (default descriptor class) -@item 4 -by descriptor (UBS: unaligned bit string) -@item 5 -by descriptor (UBSB: aligned bit string with arbitrary bounds) -@item 6 -by descriptor (UBA: unaligned bit array) -@item 7 -by descriptor (S: string, also scalar access type parameter) -@item 8 -by descriptor (SB: string with arbitrary bounds) -@item 9 -by descriptor (A: contiguous array) -@item 10 -by descriptor (NCA: non-contiguous array) @end table -@noindent -Values from 3 through 10 are only relevant to Digital OpenVMS implementations. -@cindex OpenVMS - @node Attribute Null_Parameter @unnumberedsec Attribute Null_Parameter @cindex Zero address, passing diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 29cffb049f9..6c93c0ba62e 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -630,8 +630,7 @@ procedure Gnatlink is Linker_Objects.Table (Linker_Objects.Last) := new String'(Arg); - -- If host object file, record object file e.g. accept foo.o - -- as well as foo.obj on VMS target. + -- If host object file, record object file elsif Arg'Length > Get_Object_Suffix.all'Length and then Arg @@ -730,18 +729,17 @@ procedure Gnatlink is -- Save state of -shared option Xlinker_Was_Previous : Boolean := False; - -- Indicate that "-Xlinker" was the option preceding the current - -- option. If True, then the current option is never suppressed. + -- Indicate that "-Xlinker" was the option preceding the current option. + -- If True, then the current option is never suppressed. -- Rollback data - -- These data items are used to store current binder file context. - -- The context is composed of the file descriptor position and the - -- current line together with the slice indexes (first and last - -- position) for this line. The rollback data are used by the - -- Store_File_Context and Rollback_File_Context routines below. - -- The file context mechanism interact only with the Get_Next_Line - -- call. For example: + -- These data items are used to store current binder file context. The + -- context is composed of the file descriptor position and the current + -- line together with the slice indexes (first and last position) for + -- this line. The rollback data are used by the Store_File_Context and + -- Rollback_File_Context routines below. The file context mechanism + -- interact only with the Get_Next_Line call. For example: -- Store_File_Context; -- Get_Next_Line; @@ -772,7 +770,7 @@ procedure Gnatlink is pragma Import (C, Object_Library_Ext_Ptr, "__gnat_object_library_extension"); -- Pointer to string specifying the default extension for - -- object libraries, e.g. Unix uses ".a", VMS uses ".olb". + -- object libraries, e.g. Unix uses ".a". Separate_Run_Path_Options : Boolean; for Separate_Run_Path_Options'Size use Character'Size; diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 07815d0d5b5..3db4d617be9 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -1627,7 +1627,7 @@ begin Osint.Add_Default_Search_Dirs; -- Get the target parameters, but only if switch -nostdinc was not - -- specified. Likely not strictly needed now that VMS is baselined??? + -- specified. May not be needed any more, but is harmless. if not Opt.No_Stdinc then Get_Target_Parameters; diff --git a/gcc/ada/i-cstrea.adb b/gcc/ada/i-cstrea.adb index e072b0d414e..d831206b47b 100644 --- a/gcc/ada/i-cstrea.adb +++ b/gcc/ada/i-cstrea.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- @@ -29,10 +29,6 @@ -- -- ------------------------------------------------------------------------------ --- This is the default version which just calls the C versions directly --- Note: the reason that we provide for specialization here is that on --- some systems, notably VMS, we may need to worry about buffering. - with Ada.Unchecked_Conversion; package body Interfaces.C_Streams is diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index a56acc06ed3..79f9de1c82b 100644 --- a/gcc/ada/krunch.adb +++ b/gcc/ada/krunch.adb @@ -33,9 +33,7 @@ procedure Krunch (Buffer : in out String; Len : in out Natural; Maxlen : Natural; - No_Predef : Boolean; - VMS_On_Target : Boolean := False) - + No_Predef : Boolean) is pragma Assert (Buffer'First = 1); -- This is a documented requirement; the assert turns off index warnings @@ -118,34 +116,15 @@ begin -- Special case of a child unit whose parent unit is a single letter that -- is A, G, I, or S. In order to prevent confusion with krunched names -- of predefined units use a tilde rather than a minus as the second - -- character of the file name. On VMS a tilde is an illegal character - -- in a file name, two consecutive underlines ("__") are used instead. + -- character of the file name. elsif Len > 1 and then Buffer (2) = '-' and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's') and then Len <= Maxlen then - if VMS_On_Target then - Len := Len + 1; - Buffer (4 .. Len) := Buffer (3 .. Len - 1); - Buffer (2) := '_'; - Buffer (3) := '_'; - else - Buffer (2) := '~'; - end if; - - if Len <= Maxlen then - return; - - else - -- Case of VMS when the buffer had exactly the length Maxlen and now - -- has the length Maxlen + 1: krunching after "__" is needed. - - Startloc := 4; - Curlen := Len; - Krlen := Maxlen; - end if; + Buffer (2) := '~'; + return; -- Normal case, not a predefined file diff --git a/gcc/ada/krunch.ads b/gcc/ada/krunch.ads index 2a6d9681ed4..7cfb637c57f 100644 --- a/gcc/ada/krunch.ads +++ b/gcc/ada/krunch.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- -- @@ -121,8 +121,7 @@ procedure Krunch (Buffer : in out String; Len : in out Natural; Maxlen : Natural; - No_Predef : Boolean; - VMS_On_Target : Boolean := False); + No_Predef : Boolean); pragma Elaborate_Body (Krunch); -- The full file name is stored in Buffer (1 .. Len) on entry. The file -- name is crunched in place and on return Len is updated, so that the @@ -131,8 +130,6 @@ pragma Elaborate_Body (Krunch); -- case it may be possible that Krunch does not modify Buffer. The fourth -- parameter, No_Predef, is a switch which, if set to True, disables the -- normal special treatment of predefined library unit file names. --- VMS_On_Target, when True, indicates to Krunch to apply the VMS treatment --- to the children of package A, G,I or S. -- -- Note: the string Buffer must have a lower bound of 1, and may not -- contain any blanks (in particular, it must not have leading blanks). diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index d9108c9803c..2692c8bb2b3 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -2526,31 +2526,6 @@ package body Layout is Init_Size (E, System_Address_Size); end if; - -- On VMS, reset size to 32 for convention C access type if no - -- explicit size clause is given and the default size is 64. Really - -- we do not know the size, since depending on options for the VMS - -- compiler, the size of a pointer type can be 32 or 64, but choosing - -- 32 as the default improves compatibility with legacy VMS code. - - -- Note: we do not use Has_Size_Clause in the test below, because we - -- want to catch the case of a derived type inheriting a size clause. - -- We want to consider this to be an explicit size clause for this - -- purpose, since it would be weird not to inherit the size in this - -- case. - - -- We do NOT do this if we are in -gnatdm mode on a non-VMS target - -- since in that case we want the normal pointer representation. - - if Opt.True_VMS_Target - and then (Convention (E) = Convention_C - or else - Convention (E) = Convention_CPP) - and then No (Get_Attribute_Definition_Clause (E, Attribute_Size)) - and then Esize (E) = 64 - then - Init_Size (E, 32); - end if; - Set_Elem_Alignment (E); -- Scalar types: set size and alignment @@ -3022,8 +2997,7 @@ package body Layout is -- If Optimize_Alignment is set to Time, then we reset for odd -- "in between sizes", for example a 17 bit record is given an - -- alignment of 4. Note that this matches the old VMS behavior - -- in versions of GNAT prior to 6.1.1. + -- alignment of 4. elsif Optimize_Alignment_Time (E) and then Siz > System_Storage_Unit diff --git a/gcc/ada/lib-util.adb b/gcc/ada/lib-util.adb index ae6e204c223..71c05ee170e 100644 --- a/gcc/ada/lib-util.adb +++ b/gcc/ada/lib-util.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- -- @@ -100,10 +100,9 @@ package body Lib.Util is procedure Write_Info_EOL is begin - if Hostparm.OpenVMS - or else Info_Buffer_Len + Max_Line + 1 > Max_Buffer - then + if Info_Buffer_Len + Max_Line + 1 > Max_Buffer then Write_Info_Terminate; + else -- Delete any trailing blanks diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 05cb6f14308..3ae8f272c67 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2626,65 +2626,58 @@ package body Make is Data := No_Compilation_Data; OK := False; - -- The loop here is a work-around for a problem on VMS; in some - -- circumstances (shared library and several executables, for - -- example), there are child processes other than compilation - -- processes that are received. ??? Revisit now that VMS is no - -- longer supported. + Wait_Process (Pid, OK); - loop - Wait_Process (Pid, OK); + if Pid = Invalid_Pid then + return; + end if; - if Pid = Invalid_Pid then - return; - end if; + -- Look into the running compilation processes for this PID - for J in Running_Compile'First .. Outstanding_Compiles loop - if Pid = Running_Compile (J).Pid then - Data := Running_Compile (J); - Project := Running_Compile (J).Project; + for J in Running_Compile'First .. Outstanding_Compiles loop + if Pid = Running_Compile (J).Pid then + Data := Running_Compile (J); + Project := Running_Compile (J).Project; - if Project /= No_Project then - Queue.Set_Obj_Dir_Free (Project.Object_Directory.Name); - end if; - - -- If a mapping file was used by this compilation, get its - -- file name for reuse by a subsequent compilation. - - if Running_Compile (J).Mapping_File /= No_Mapping_File then - Comp_Data := - Project_Compilation_Htable.Get - (Project_Compilation, Project); - Comp_Data.Last_Free_Indexes := - Comp_Data.Last_Free_Indexes + 1; - Comp_Data.Free_Mapping_File_Indexes - (Comp_Data.Last_Free_Indexes) := - Running_Compile (J).Mapping_File; - end if; + if Project /= No_Project then + Queue.Set_Obj_Dir_Free (Project.Object_Directory.Name); + end if; - -- To actually remove this Pid and related info from - -- Running_Compile replace its entry with the last valid - -- entry in Running_Compile. + -- If a mapping file was used by this compilation, get its file + -- name for reuse by a subsequent compilation. + + if Running_Compile (J).Mapping_File /= No_Mapping_File then + Comp_Data := + Project_Compilation_Htable.Get + (Project_Compilation, Project); + Comp_Data.Last_Free_Indexes := + Comp_Data.Last_Free_Indexes + 1; + Comp_Data.Free_Mapping_File_Indexes + (Comp_Data.Last_Free_Indexes) := + Running_Compile (J).Mapping_File; + end if; - if J = Outstanding_Compiles then - null; - else - Running_Compile (J) := - Running_Compile (Outstanding_Compiles); - end if; + -- To actually remove this Pid and related info from + -- Running_Compile replace its entry with the last valid + -- entry in Running_Compile. - Outstanding_Compiles := Outstanding_Compiles - 1; - return; + if J = Outstanding_Compiles then + null; + else + Running_Compile (J) := + Running_Compile (Outstanding_Compiles); end if; - end loop; - -- This child process was not one of our compilation processes; - -- just ignore it for now. + Outstanding_Compiles := Outstanding_Compiles - 1; + exit; + end if; + end loop; - -- Why is this commented out code sitting here??? + -- If the PID was not found, return with OK set to False - -- raise Program_Error; - end loop; + if Data = No_Compilation_Data then + OK := False; + end if; end Await_Compile; --------------------------- @@ -4638,11 +4631,13 @@ package body Make is Library_Projs.Table (Current) := Proj; end Add_To_Library_Projs; + -- Start of processing for Library_Phase + begin Library_Projs.Init; - -- Put in Library_Projs table all library project file - -- ids when the library need to be rebuilt. + -- Put in Library_Projs table all library project file ids when the + -- library need to be rebuilt. Proj1 := Project_Tree.Projects; while Proj1 /= null loop diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index 1c34efeee22..c4faea0e4a1 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -205,8 +205,11 @@ package body MLib is S := new String (1 .. Len + 3); - -- Read the file. Note that the loop is not necessary - -- since the whole file is read at once except on VMS. + -- Read the file. This loop is probably not necessary + -- since on most (all?) targets, the whole file is + -- read in at once, but we have encountered systems + -- in the past where this was not true, and we retain + -- this loop in case we encounter that in the future. Curr := S'First; while Curr <= Len loop diff --git a/gcc/ada/osint-b.adb b/gcc/ada/osint-b.adb index 39b7a99be84..554d804af96 100644 --- a/gcc/ada/osint-b.adb +++ b/gcc/ada/osint-b.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -25,7 +25,6 @@ with Opt; use Opt; with Output; use Output; -with Targparm; use Targparm; package body Osint.B is @@ -75,9 +74,8 @@ package body Osint.B is Findex2 : Natural; Flength : Natural; - Bind_File_Prefix_Len : Natural := 2; - -- Length of binder file prefix (normally set to 2 for b~, but gets - -- reset to 3 for VMS for b__). + Bind_File_Prefix_Len : constant Natural := 2; + -- Length of binder file prefix (2 for b~) begin if Output_File_Name /= "" then @@ -120,10 +118,6 @@ package body Osint.B is if Maximum_File_Name_Length > 0 then - if OpenVMS_On_Target and then Typ /= 'c' then - Bind_File_Prefix_Len := 3; - end if; - -- Make room for the extra two characters in "b?" while Int (Flength) > @@ -139,31 +133,15 @@ package body Osint.B is File_Name (Findex1 .. Findex2 - 1); Name_Buffer (Flength + Bind_File_Prefix_Len + 1) := '.'; - -- C bind file, name is b_xxx.c - - if Typ = 'c' then - Name_Buffer (2) := '_'; - Name_Buffer (Flength + 4) := 'c'; - Name_Buffer (Flength + 5) := ASCII.NUL; - Name_Len := Flength + 4; - -- Ada bind file, name is b~xxx.adb or b~xxx.ads - -- (with __ instead of ~ in VMS) - - else - if OpenVMS_On_Target then - Name_Buffer (2) := '_'; - Name_Buffer (3) := '_'; - else - Name_Buffer (2) := '~'; - end if; - Name_Buffer (Flength + Bind_File_Prefix_Len + 2) := 'a'; - Name_Buffer (Flength + Bind_File_Prefix_Len + 3) := 'd'; - Name_Buffer (Flength + Bind_File_Prefix_Len + 4) := Typ; - Name_Buffer (Flength + Bind_File_Prefix_Len + 5) := ASCII.NUL; - Name_Len := Flength + Bind_File_Prefix_Len + 4; - end if; + Name_Buffer (2) := '~'; + + Name_Buffer (Flength + Bind_File_Prefix_Len + 2) := 'a'; + Name_Buffer (Flength + Bind_File_Prefix_Len + 3) := 'd'; + Name_Buffer (Flength + Bind_File_Prefix_Len + 4) := Typ; + Name_Buffer (Flength + Bind_File_Prefix_Len + 5) := ASCII.NUL; + Name_Len := Flength + Bind_File_Prefix_Len + 4; end if; Bfile := Name_Find; diff --git a/gcc/ada/osint-b.ads b/gcc/ada/osint-b.ads index d24ec91ee21..a7f50252f50 100644 --- a/gcc/ada/osint-b.ads +++ b/gcc/ada/osint-b.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -44,17 +44,15 @@ package Osint.B is -- Binder Output -- ------------------- - -- These routines are used by the binder to generate the C or Ada source - -- files containing the binder output. The format of these files is - -- described in package Bindgen. + -- These routines are used by the binder to generate the Ada source files + -- containing the binder output. The format of these files is described in + -- package Bindgen. procedure Create_Binder_Output (Output_File_Name : String; Typ : Character; Bfile : out Name_Id); -- Creates the binder output file. Typ is one of - -- - -- 'c' create output file for case of generating C -- 'b' create body file for case of generating Ada -- 's' create spec file for case of generating Ada -- diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index d7faeba8057..536133f9ff7 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -23,9 +23,8 @@ -- -- ------------------------------------------------------------------------------ -with Hostparm; -with Opt; use Opt; -with Tree_IO; use Tree_IO; +with Opt; use Opt; +with Tree_IO; use Tree_IO; package body Osint.C is @@ -127,12 +126,7 @@ package body Osint.C is begin Get_Name_String (Src); - if Hostparm.OpenVMS then - Name_Buffer (Name_Len + 1) := '_'; - else - Name_Buffer (Name_Len + 1) := '.'; - end if; - + Name_Buffer (Name_Len + 1) := '.'; Name_Len := Name_Len + 1; Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix; Name_Len := Name_Len + Suffix'Length; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 0902ae29158..5f0842c346a 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -365,8 +365,9 @@ package body Osint is S := new String (1 .. Len); - -- Read the file. Note that the loop is not necessary since the - -- whole file is read at once except on VMS. + -- Read the file. Note that the loop is probably not necessary any + -- more since the whole file is read in at once on all targets. But + -- it is harmless and might be needed in future. Curr := 1; Actual_Len := Len; @@ -473,31 +474,21 @@ package body Osint is Get_Dirs_From_File (Additional_Source_Dir => False); end if; - -- On VMS, don't expand the logical name (e.g. environment variable), - -- just put it into Unix (e.g. canonical) format. System services - -- will handle the expansion as part of the file processing. + -- Put path name in canonical form for Additional_Source_Dir in False .. True loop if Additional_Source_Dir then Search_Path := Getenv (Ada_Include_Path); if Search_Path'Length > 0 then - if Hostparm.OpenVMS then - Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:"); - else - Search_Path := To_Canonical_Path_Spec (Search_Path.all); - end if; + Search_Path := To_Canonical_Path_Spec (Search_Path.all); end if; else Search_Path := Getenv (Ada_Objects_Path); if Search_Path'Length > 0 then - if Hostparm.OpenVMS then - Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:"); - else - Search_Path := To_Canonical_Path_Spec (Search_Path.all); - end if; + Search_Path := To_Canonical_Path_Spec (Search_Path.all); end if; end if; @@ -512,9 +503,7 @@ package body Osint is -- For the compiler, if --RTS= was specified, add the runtime -- directories. - if RTS_Src_Path_Name /= null - and then RTS_Lib_Path_Name /= null - then + if RTS_Src_Path_Name /= null and then RTS_Lib_Path_Name /= null then Add_Search_Dirs (RTS_Src_Path_Name, Include); Add_Search_Dirs (RTS_Lib_Path_Name, Objects); @@ -853,13 +842,12 @@ package body Osint is Buffer : String := Name_Buffer (1 .. Name_Len); begin - -- Get the file name in canonical case to accept as is names - -- ending with ".EXE" on VMS and Windows. + -- Get the file name in canonical case to accept as is. Names + -- end with ".EXE" on Windows. Canonical_Case_File_Name (Buffer); - -- If Executable does not end with the executable suffix, add - -- it. + -- If Executable doesn't end with the executable suffix, add it if Buffer'Length <= Exec_Suffix'Length or else @@ -1183,12 +1171,8 @@ package body Osint is if T = Config or else (Debug_Generated_Code - and then Name_Len > 3 - and then - (Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg" - or else - (Hostparm.OpenVMS and then - Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg"))) + and then Name_Len > 3 + and then Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg") then Found := N; Attr.all := Unknown_Attributes; @@ -1292,9 +1276,9 @@ package body Osint is -- Command_Name(Cindex1 .. Cindex2) is now the equivalent of the -- POSIX command "basename argv[0]" - -- Strip off any versioning information such as found on VMS. - -- This would take the form of TOOL.exe followed by a ";" or "." - -- and a sequence of one or more numbers. + -- Strip off any versioning information found on some systems. This + -- would take the form of TOOL.exe followed by a ";" or "." and a + -- sequence of one or more numbers. if Command_Name (Cindex2) in '0' .. '9' then for J in reverse Cindex1 .. Cindex2 loop @@ -1702,15 +1686,9 @@ package body Osint is function Is_Directory_Separator (C : Character) return Boolean is begin -- In addition to the default directory_separator allow the '/' to - -- act as separator since this is allowed in MS-DOS, Windows 95/NT, - -- and OS2 ports. On VMS, the situation is more complicated because - -- there are two characters to check for. - - return - C = Directory_Separator - or else C = '/' - or else (Hostparm.OpenVMS - and then (C = ']' or else C = ':')); + -- act as separator since this is allowed in MS-DOS and Windows. + + return C = Directory_Separator or else C = '/'; end Is_Directory_Separator; ------------------------- @@ -2202,11 +2180,7 @@ package body Osint is function Prep_Suffix return String is begin - if Hostparm.OpenVMS then - return "_prep"; - else - return ".prep"; - end if; + return ".prep"; end Prep_Suffix; ------------------ @@ -2344,8 +2318,9 @@ package body Osint is S := new String (1 .. Len + 1); S (Len + 1) := Path_Separator; - -- Read the file. Note that the loop is not necessary since the - -- whole file is read at once except on VMS. + -- Read the file. Note that the loop is probably not necessary since the + -- whole file is read at once but the loop is harmless and that way we + -- are sure to accomodate systems where this is not the case. Curr := 1; Actual_Len := Len; @@ -2565,9 +2540,9 @@ package body Osint is Text := new Text_Buffer (Lo .. Hi); - -- Some systems (e.g. VMS) have file types that require one - -- read per line, so read until we get the Len bytes or until - -- there are no more characters. + -- Some systems have file types that require one read per line, + -- so read until we get the Len bytes or until there are no more + -- characters. Hi := Lo; loop @@ -2698,9 +2673,9 @@ package body Osint is begin -- Allocate source buffer, allowing extra character at end for EOF - -- Some systems (e.g. VMS) have file types that require one read per - -- line, so read until we get the Len bytes or until there are no - -- more characters. + -- Some systems have file types that require one read per line, + -- so read until we get the Len bytes or until there are no more + -- characters. Hi := Lo; loop @@ -2806,15 +2781,6 @@ package body Osint is Library (3 .. 2 + Name'Length) := Name; Library (3 + Name'Length) := '-'; Library (4 + Name'Length .. Library'Last) := Library_Version; - - if OpenVMS_On_Target then - for K in Library'First + 2 .. Library'Last loop - if Library (K) = '.' or else Library (K) = '-' then - Library (K) := '_'; - end if; - end loop; - end if; - return Library; end Shared_Lib; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index e1c04c18467..0ff67381f71 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.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- -- @@ -43,9 +43,9 @@ pragma Elaborate_All (System.OS_Lib); package Osint is - Multi_Unit_Index_Character : Character := '~'; + Multi_Unit_Index_Character : constant Character := '~'; -- The character before the index of the unit in a multi-unit source in ALI - -- and object file names. Changed to '$' on VMS. + -- and object file names. Ada_Include_Path : constant String := "ADA_INCLUDE_PATH"; Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH"; @@ -201,33 +201,27 @@ package Osint is function To_Canonical_File_List (Wildcard_Host_File : String; Only_Dirs : Boolean) return String_Access_List_Access; - -- Expand a wildcard host syntax file or directory specification (e.g. on - -- a VMS host, any file or directory spec that contains: "*", or "%", or - -- "...") and return a list of valid Unix syntax file or directory specs. - -- If Only_Dirs is True, then only return directories. + -- Expand a wildcard host syntax file or directory specification and return + -- a list of valid Unix syntax file or directory specs. If Only_Dirs is + -- True, then only return directories. function To_Canonical_Dir_Spec (Host_Dir : String; Prefix_Style : Boolean) return String_Access; - -- Convert a host syntax directory specification (e.g. on a VMS host: - -- "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir"). - -- If Prefix_Style then make it a valid file specification prefix. A file - -- specification prefix is a directory specification that can be appended - -- with a simple file specification to yield a valid absolute or relative - -- path to a file. On a conversion to Unix syntax this simply means the - -- spec has a trailing slash ("/"). + -- Convert a host syntax directory specification to canonical (Unix) + -- syntax. If Prefix_Style then make it a valid file specification prefix. + -- A file specification prefix is a directory specification that can be + -- appended with a simple file specification to yield a valid absolute + -- or relative path to a file. On a conversion to Unix syntax this simply + -- means the spec has a trailing slash ("/"). function To_Canonical_File_Spec (Host_File : String) return String_Access; - -- Convert a host syntax file specification (e.g. on a VMS host: - -- "SYS$DEVICE:[DIR]FILE.EXT;69 to canonical (Unix) syntax (e.g. - -- "/sys$device/dir/file.ext.69"). + -- Convert a host syntax file specification to canonical (Unix) syntax function To_Canonical_Path_Spec (Host_Path : String) return String_Access; - -- Convert a host syntax Path specification (e.g. on a VMS host: - -- "SYS$DEVICE:[BAR],DISK$USER:[FOO] to canonical (Unix) syntax (e.g. - -- "/sys$device/foo:disk$user/foo"). + -- Convert a host syntax Path specification to canonical (Unix) syntax function To_Host_Dir_Spec (Canonical_Dir : String; @@ -254,7 +248,7 @@ package Osint is -- Returns the runtime shared library in the form -l<name>-<version> where -- version is the GNAT runtime library option for the platform. For example -- this routine called with Name set to "gnat" will return "-lgnat-5.02" - -- on UNIX and Windows and -lgnat_5_02 on VMS. + -- on UNIX and Windows. --------------------- -- File attributes -- diff --git a/gcc/ada/output.ads b/gcc/ada/output.ads index e4137c2add6..71b25ad4302 100644 --- a/gcc/ada/output.ads +++ b/gcc/ada/output.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- -- @@ -209,11 +209,8 @@ private Buffer : String (1 .. Buffer_Max + 1) := (others => '*'); for Buffer'Alignment use 4; - -- Buffer used to build output line. We do line buffering because it - -- is needed for the support of the debug-generated-code option (-gnatD). - -- Historically it was first added because on VMS, line buffering is - -- needed with certain file formats. So in any case line buffering must - -- be retained for this purpose, even if other reasons disappear. Note + -- Buffer used to build output line. We do line buffering because it is + -- needed for the support of the debug-generated-code option (-gnatD). Note -- any attempt to write more output to a line than can fit in the buffer -- will be silently ignored. The alignment clause improves the efficiency -- of the save/restore procedures. diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index c1363edee75..53b19f53fce 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -1564,9 +1564,7 @@ begin -- mode, check that language-defined units are compiled in GNAT -- mode. For this purpose we do NOT consider renamings in annex -- J as predefined. That allows users to compile their own - -- versions of these files, and in particular, in the VMS - -- implementation, the DEC versions can be substituted for the - -- standard Ada 95 versions. Another exception is System.RPC + -- versions of these files. Another exception is System.RPC -- and its children. This allows a user to supply their own -- communication layer. diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index c6163fbcad9..8667e09eb2d 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -23,7 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Hostparm; with Makeutl; use Makeutl; with MLib.Tgt; with Opt; use Opt; @@ -1416,18 +1415,10 @@ package body Prj.Conf is <<Process_Config_File>> if Automatically_Generated then - if Hostparm.OpenVMS then - -- There is no gprconfig on VMS - - Raise_Invalid_Config - ("could not locate any configuration project file"); - - else - -- This might raise an Invalid_Config exception + -- This might raise an Invalid_Config exception Do_Autoconf; - end if; -- If the config file is not auto-generated, warn if there is any --RTS -- switch, but not when the config file is generated in memory. diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 76398608434..7a0ecbebef7 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -24,7 +24,6 @@ ------------------------------------------------------------------------------ with Fmap; -with Hostparm; with Makeutl; use Makeutl; with Opt; with Osint; use Osint; @@ -1905,8 +1904,6 @@ package body Prj.Env is Add_Default_Dir : Boolean := True; First : Positive; Last : Positive; - New_Len : Positive; - New_Last : Positive; Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; Gpr_Project_Path : constant String := "GPR_PROJECT_PATH"; @@ -2043,35 +2040,6 @@ package body Prj.Env is -- directory correctly. Last := Last - 1; - - elsif not Hostparm.OpenVMS - or else not Is_Absolute_Path (Name_Buffer (First .. Last)) - then - -- On VMS, only expand relative path names, as absolute paths - -- may correspond to multi-valued VMS logical names. - - declare - New_Dir : constant String := - Normalize_Pathname - (Name_Buffer (First .. Last), - Resolve_Links => Opt.Follow_Links_For_Dirs); - - begin - -- If the absolute path was resolved and is different from - -- the original, replace original with the resolved path. - - if New_Dir /= Name_Buffer (First .. Last) - and then New_Dir'Length /= 0 - then - New_Len := Name_Len + New_Dir'Length - (Last - First + 1); - New_Last := First + New_Dir'Length - 1; - Name_Buffer (New_Last + 1 .. New_Len) := - Name_Buffer (Last + 1 .. Name_Len); - Name_Buffer (First .. New_Last) := New_Dir; - Name_Len := New_Len; - Last := New_Last; - end if; - end; end if; First := Last + 1; diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 4f4ab43c08c..d58f4df9a1d 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -24,7 +24,6 @@ ------------------------------------------------------------------------------ with Csets; -with Hostparm; with Makeutl; use Makeutl; with Opt; with Output; @@ -1058,11 +1057,9 @@ package body Prj.Makr is Project_File_Extension; Output_Name_Last := Output_Name_Last + Project_File_Extension'Length; - -- Back up project file if it already exists (not needed in VMS since - -- versioning of files takes care of this requirement on VMS). + -- Back up project file if it already exists - if not Hostparm.OpenVMS - and then not Opt.No_Backup + if not Opt.No_Backup and then Is_Regular_File (Path_Name (1 .. Path_Last)) then declare @@ -1280,15 +1277,6 @@ package body Prj.Makr is new String'(Get_Name_String (Tmp_File)); end if; - -- On VMS, a file created with Create_Temp_File cannot - -- be used to redirect output. - - if Hostparm.OpenVMS then - Close (FD); - Delete_File (Temp_File_Name.all, Success); - FD := Create_Output_Text_File (Temp_File_Name.all); - end if; - Args (Args'Last) := new String' (Dir_Name & Directory_Separator & diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index b9135c24f0d..fb14af79731 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -34,7 +34,6 @@ with Prj.Tree; use Prj.Tree; with Prj.Util; use Prj.Util; with Sinput.P; with Snames; use Snames; -with Targparm; use Targparm; with Ada; use Ada; with Ada.Characters.Handling; use Ada.Characters.Handling; @@ -5222,22 +5221,6 @@ package body Prj.Nmsc is Name_Len := The_Name'Length; Name_Buffer (1 .. Name_Len) := The_Name; - -- Special cases of children of packages A, G, I and S on VMS - - if OpenVMS_On_Target - and then Name_Len > 3 - and then Name_Buffer (2 .. 3) = "__" - and then - (Name_Buffer (1) = 'a' or else - Name_Buffer (1) = 'g' or else - Name_Buffer (1) = 'i' or else - Name_Buffer (1) = 's') - then - Name_Buffer (2) := '.'; - Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len); - Name_Len := Name_Len - 1; - end if; - Real_Name := Name_Find; if Is_Reserved (Real_Name) then diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 73b77099baa..6699c4fd076 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -276,8 +276,7 @@ package body Prj is -- If any of the environment variables ADA_PRJ_INCLUDE_FILE or -- ADA_PRJ_OBJECTS_FILE has been set, then reset their value to - -- the empty string. On VMS, this has the effect of deassigning - -- the logical names. + -- the empty string. if Shared.Private_Part.Current_Source_Path_File /= No_Path then Setenv (Project_Include_Path_File, ""); diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 8ad6143ecd7..329cc6d2115 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -441,10 +441,8 @@ package Prj is No_Source : constant Source_Id := null; type Path_Syntax_Kind is - (Canonical, - -- Unix style - Host); - -- Host specific syntax, for example on VMS (the default) + (Canonical, -- Unix style + Host); -- Host specific syntax -- The following record describes the configuration of a language @@ -484,8 +482,7 @@ package Prj is -- unit in a multi-source file, in the object file name. Path_Syntax : Path_Syntax_Kind := Host; - -- Value may be Canonical (Unix style) or Host (host syntax, for example - -- on VMS for DEC C). + -- Value may be Canonical (Unix style) or Host (host syntax) Source_File_Switches : Name_List_Index := No_Name_List; -- Optional switches to be put before the source file. The source file @@ -2012,9 +2009,8 @@ private Current_Source_Path_File : Path_Name_Type := No_Path; -- Current value of project source path file env var. Used to avoid -- setting the env var to the same value. When different from No_Path, - -- this indicates that logical names (VMS) or environment variables were - -- created and should be deassigned to avoid polluting the environment - -- on VMS. This is for gnatmake only. + -- this indicates that environment variables were created and should be + -- deassigned to avoid polluting the environment. For gnatmake only. Current_Object_Path_File : Path_Name_Type := No_Path; -- Current value of project object path file env var. Used to avoid diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index dbec602e985..5e8861e4bac 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1477,30 +1477,6 @@ package body Repinfo is when -2 => Write_Str ("reference"); - when -3 => - Write_Str ("descriptor"); - - when -4 => - Write_Str ("descriptor (UBS)"); - - when -5 => - Write_Str ("descriptor (UBSB)"); - - when -6 => - Write_Str ("descriptor (UBA)"); - - when -7 => - Write_Str ("descriptor (S)"); - - when -8 => - Write_Str ("descriptor (SB)"); - - when -9 => - Write_Str ("descriptor (A)"); - - when -10 => - Write_Str ("descriptor (NCA)"); - when others => raise Program_Error; end case; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 499b167bb0a..a31215f960b 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -1126,10 +1126,10 @@ package body Rtsfind is procedure Check_RPC; -- Reject programs that make use of distribution features not supported - -- on the current target. Also check that the PCS is compatible with - -- the code generator version. On such targets (VMS, Vxworks, others?) - -- we provide a minimal body for System.Rpc that only supplies an - -- implementation of Partition_Id. + -- on the current target. Also check that the PCS is compatible with the + -- code generator version. On such targets (Vxworks, others?) we provide + -- a minimal body for System.Rpc that only supplies an implementation of + -- Partition_Id. function Find_Local_Entity (E : RE_Id) return Entity_Id; -- This function is used when entity E is in this compilation's main diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index bb57b1c0f8b..e1853fa21b0 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -376,7 +376,6 @@ package Rtsfind is System_Val_WChar, System_Vax_Float_Operations, System_Version_Control, - System_VMS_Exception_Table, System_WCh_StW, System_WCh_WtS, System_Wid_Bool, @@ -1690,8 +1689,6 @@ package Rtsfind is RE_Version_String, -- System.Version_Control RE_Get_Version_String, -- System.Version_Control - RE_Register_VMS_Exception, -- System.VMS_Exception_Table - RE_String_To_Wide_String, -- System.WCh_StW RE_String_To_Wide_Wide_String, -- System.WCh_StW @@ -2977,8 +2974,6 @@ package Rtsfind is RE_Version_String => System_Version_Control, RE_Get_Version_String => System_Version_Control, - RE_Register_VMS_Exception => System_VMS_Exception_Table, - RE_String_To_Wide_String => System_WCh_StW, RE_String_To_Wide_Wide_String => System_WCh_StW, diff --git a/gcc/ada/s-excmac-gcc.ads b/gcc/ada/s-excmac-gcc.ads index 3700993c47f..1a7aba55531 100644 --- a/gcc/ada/s-excmac-gcc.ads +++ b/gcc/ada/s-excmac-gcc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2013-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- -- @@ -147,8 +147,7 @@ package System.Exceptions.Machine is -- maintain anyway. type GCC_Exception_Access is access all Unwind_Exception; - -- Pointer to a GCC exception. Do not use convention C as on VMS this - -- would imply the use of 32-bits pointers. + -- Pointer to a GCC exception procedure Unwind_DeleteException (Excp : not null GCC_Exception_Access); pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException"); diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb index 2644e675bd6..259b9d1089f 100644 --- a/gcc/ada/s-fatgen.adb +++ b/gcc/ada/s-fatgen.adb @@ -823,8 +823,7 @@ package body System.Fat_Gen is Most_Significant_Word : constant Rep_Index := Rep_Last * Standard'Default_Bit_Order; -- Finding the location of the Exponent_Word is a bit tricky. In general - -- we assume Word_Order = Bit_Order. This expression needs to be refined - -- for VMS. + -- we assume Word_Order = Bit_Order. Exponent_Factor : constant Float_Word := 2**(Float_Word'Size - 1) / diff --git a/gcc/ada/s-mastop.ads b/gcc/ada/s-mastop.ads index 93f06f8f24a..216d79bbd15 100644 --- a/gcc/ada/s-mastop.ads +++ b/gcc/ada/s-mastop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-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- -- @@ -40,10 +40,10 @@ with System.Storage_Elements; package System.Machine_State_Operations is subtype Code_Loc is System.Address; - -- Code location used in building exception tables and for call - -- addresses when propagating an exception (also traceback table) - -- Values of this type are created by using Label'Address or - -- extracted from machine states using Get_Code_Loc. + -- Code location used in building exception tables and for call addresses + -- when propagating an exception (also traceback table) Values of this + -- type are created by using Label'Address or extracted from machine + -- states using Get_Code_Loc. type Machine_State is new System.Address; -- The table based exception handling approach (see a-except.adb) isolates @@ -66,31 +66,28 @@ package System.Machine_State_Operations is -- The initial value of type Machine_State is created by the low level -- routine that actually raises an exception using the special builtin - -- _builtin_machine_state. This value will typically encode the value - -- of the program counter, and relevant registers. The following - -- operations are defined on Machine_State values: + -- _builtin_machine_state. This value will typically encode the value of + -- the program counter, and relevant registers. The following operations + -- are defined on Machine_State values: function Get_Code_Loc (M : Machine_State) return Code_Loc; - -- This function extracts the program counter value from a machine - -- state, which the caller uses for searching the exception tables, - -- and also for recording entries in the traceback table. The call - -- returns a value of Null_Loc if the machine state represents the - -- outer level, or some other frame for which no information can be - -- provided. + -- This function extracts the program counter value from a machine state, + -- which the caller uses for searching the exception tables, and also for + -- recording entries in the traceback table. The call returns a value of + -- Null_Loc if the machine state represents the outer level, or some other + -- frame for which no information can be provided. procedure Pop_Frame (M : Machine_State); -- This procedure pops the machine state M so that it represents the - -- call point, as though the current subprogram had returned. It - -- changes only the value referenced by M, and does not affect - -- the current stack environment. + -- call point, as though the current subprogram had returned. It changes + -- only the value referenced by M, and does not affect the current stack + -- environment. function Fetch_Code (Loc : Code_Loc) return Code_Loc; - -- Some architectures (notably VMS) use a descriptor to describe - -- a subprogram address. This function computes the actual starting + -- Some architectures (notably HPUX) use a descriptor to describe a + -- subprogram address. This function computes the actual starting -- address of the code from Loc. -- - -- ??? This function will go away when 'Code_Address is fixed on VMS. - -- -- Do not add pragma Inline to this function: there is a curious -- interaction between rtsfind and front-end inlining. The exception -- declaration in s-auxdec calls rtsfind, which forces several other system @@ -98,10 +95,10 @@ package System.Machine_State_Operations is -- compile the corresponding bodies so that inlining can take place. One -- of these packages is s-mastop, which depends on s-auxdec, which is still -- being compiled: we have not seen all the declarations in it yet, so we - -- get confused semantic errors. + -- get confused semantic errors ??? procedure Set_Machine_State (M : Machine_State); - -- This routine sets M from the current machine state. It is called - -- when an exception is initially signalled to initialize the state. + -- This routine sets M from the current machine state. It is called when an + -- exception is initially signalled to initialize the state. end System.Machine_State_Operations; diff --git a/gcc/ada/s-parame-ae653.ads b/gcc/ada/s-parame-ae653.ads index 10454b62626..3cf170a4718 100644 --- a/gcc/ada/s-parame-ae653.ads +++ b/gcc/ada/s-parame-ae653.ads @@ -109,14 +109,12 @@ package System.Parameters is long_bits : constant := Long_Integer'Size; -- Number of bits in type long and unsigned_long. The normal convention - -- is that this is the same as type Long_Integer, but this is not true - -- of all targets. For example, in OpenVMS long /= Long_Integer. + -- is that this is the same as type Long_Integer, but this may not be true + -- of all targets. ptr_bits : constant := Standard'Address_Size; subtype C_Address is System.Address; - -- Number of bits in Interfaces.C pointers, normally a standard address, - -- except on 64-bit VMS where they are 32-bit addresses, for compatibility - -- with legacy code. + -- Number of bits in Interfaces.C pointers, normally a standard address C_Malloc_Linkname : constant String := "__gnat_malloc"; -- Name of runtime function used to allocate such a pointer diff --git a/gcc/ada/s-parame-hpux.ads b/gcc/ada/s-parame-hpux.ads index 8ee4b4f2b6d..319195644e5 100644 --- a/gcc/ada/s-parame-hpux.ads +++ b/gcc/ada/s-parame-hpux.ads @@ -107,14 +107,12 @@ package System.Parameters is long_bits : constant := Long_Integer'Size; -- Number of bits in type long and unsigned_long. The normal convention - -- is that this is the same as type Long_Integer, but this is not true - -- of all targets. For example, in OpenVMS long /= Long_Integer. + -- is that this is the same as type Long_Integer, but this may not be true + -- of all targets. ptr_bits : constant := Standard'Address_Size; subtype C_Address is System.Address; - -- Number of bits in Interfaces.C pointers, normally a standard address, - -- except on 64-bit VMS where they are 32-bit addresses, for compatibility - -- with legacy code. + -- Number of bits in Interfaces.C pointers, normally a standard address C_Malloc_Linkname : constant String := "__gnat_malloc"; -- Name of runtime function used to allocate such a pointer diff --git a/gcc/ada/s-parame-vxworks.ads b/gcc/ada/s-parame-vxworks.ads index e2768e52526..10769cd696c 100644 --- a/gcc/ada/s-parame-vxworks.ads +++ b/gcc/ada/s-parame-vxworks.ads @@ -109,14 +109,12 @@ package System.Parameters is long_bits : constant := Long_Integer'Size; -- Number of bits in type long and unsigned_long. The normal convention - -- is that this is the same as type Long_Integer, but this is not true - -- of all targets. For example, in OpenVMS long /= Long_Integer. + -- is that this is the same as type Long_Integer, but this may not be true + -- of all targets. ptr_bits : constant := Standard'Address_Size; subtype C_Address is System.Address; - -- Number of bits in Interfaces.C pointers, normally a standard address, - -- except on 64-bit VMS where they are 32-bit addresses, for compatibility - -- with legacy code. + -- Number of bits in Interfaces.C pointers, normally a standard address C_Malloc_Linkname : constant String := "__gnat_malloc"; -- Name of runtime function used to allocate such a pointer diff --git a/gcc/ada/s-parame.ads b/gcc/ada/s-parame.ads index abc3f4e0f5e..2c2a2fadac9 100644 --- a/gcc/ada/s-parame.ads +++ b/gcc/ada/s-parame.ads @@ -109,14 +109,12 @@ package System.Parameters is long_bits : constant := Long_Integer'Size; -- Number of bits in type long and unsigned_long. The normal convention - -- is that this is the same as type Long_Integer, but this is not true - -- of all targets. For example, in OpenVMS long /= Long_Integer. + -- is that this is the same as type Long_Integer, but this may not be true + -- of all targets. ptr_bits : constant := Standard'Address_Size; subtype C_Address is System.Address; - -- Number of bits in Interfaces.C pointers, normally a standard address, - -- except on 64-bit VMS where they are 32-bit addresses, for compatibility - -- with legacy code. + -- Number of bits in Interfaces.C pointers, normally a standard address C_Malloc_Linkname : constant String := "__gnat_malloc"; -- Name of runtime function used to allocate such a pointer diff --git a/gcc/ada/s-soflin.ads b/gcc/ada/s-soflin.ads index 7f3ebe45afa..a339a0e9e1f 100644 --- a/gcc/ada/s-soflin.ads +++ b/gcc/ada/s-soflin.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- -- @@ -140,8 +140,8 @@ package System.Soft_Links is -- Undefer task abort (non-tasking case, does nothing) procedure Abort_Handler_NT; - -- Handle task abort (non-tasking case, does nothing). Currently, only VMS - -- uses this. + -- Handle task abort (non-tasking case, does nothing). Currently, no port + -- makes use of this, but we retain the interface for possible future use. procedure Update_Exception_NT (X : EO := Current_Target_Exception); -- Handle exception setting. This routine is provided for targets that diff --git a/gcc/ada/s-stoele.adb b/gcc/ada/s-stoele.adb index 6a3fe5cfd13..1cb5f92a23c 100644 --- a/gcc/ada/s-stoele.adb +++ b/gcc/ada/s-stoele.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- -- @@ -39,7 +39,8 @@ package body System.Storage_Elements is -- Conversion to/from address - -- Note qualification below of To_Address to avoid ambiguities on VMS + -- Note qualification below of To_Address to avoid ambiguities systems + -- where Address is a visible integer type. function To_Address is new Ada.Unchecked_Conversion (Storage_Offset, Address); diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb index b8e036288f9..871ab5abcce 100644 --- a/gcc/ada/s-tasini.adb +++ b/gcc/ada/s-tasini.adb @@ -510,7 +510,7 @@ package body System.Tasking.Initialization is -- The task is blocked on a system call waiting for the -- completion event. In this case Abort_Task may need to take - -- special action in order to succeed. Example system: VMS. + -- special action in order to succeed. then Abort_Task (T); diff --git a/gcc/ada/s-taspri-dummy.ads b/gcc/ada/s-taspri-dummy.ads index 5fe9fa34277..271f5d1c301 100644 --- a/gcc/ada/s-taspri-dummy.ads +++ b/gcc/ada/s-taspri-dummy.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2014, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -53,13 +53,8 @@ package System.Task_Primitives is end record; subtype Task_Address is System.Address; - -- In some versions of Task_Primitives, notably for VMS, Task_Address is - -- the short version of address defined in System.Aux_DEC. To avoid - -- dragging Aux_DEC into tasking packages a tasking specific subtype is - -- defined here. - Task_Address_Size : constant := Standard'Address_Size; - -- The size of Task_Address + -- Type used for task addresses and its size Alternate_Stack_Size : constant := 0; -- No alternate signal stack is used on this platform diff --git a/gcc/ada/s-taspri-hpux-dce.ads b/gcc/ada/s-taspri-hpux-dce.ads index 8010c2a5b2b..137f34b8aed 100644 --- a/gcc/ada/s-taspri-hpux-dce.ads +++ b/gcc/ada/s-taspri-hpux-dce.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2014, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -63,13 +63,8 @@ package System.Task_Primitives is -- Ada_Task_Control_Block. subtype Task_Address is System.Address; - -- In some versions of Task_Primitives, notably for VMS, Task_Address is - -- the short version of address defined in System.Aux_DEC. To avoid - -- dragging Aux_DEC into tasking packages a tasking specific subtype is - -- defined here. - Task_Address_Size : constant := Standard'Address_Size; - -- The size of Task_Address + -- Type used for task addresses and its size Alternate_Stack_Size : constant := 0; -- No alternate signal stack is used on this platform diff --git a/gcc/ada/s-taspri-mingw.ads b/gcc/ada/s-taspri-mingw.ads index cc4f4019fa9..a4306254144 100644 --- a/gcc/ada/s-taspri-mingw.ads +++ b/gcc/ada/s-taspri-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2014, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -62,13 +62,8 @@ package System.Task_Primitives is -- Ada_Task_Control_Block. subtype Task_Address is System.Address; - -- In some versions of Task_Primitives, notably for VMS, Task_Address is - -- the short version of address defined in System.Aux_DEC. To avoid - -- dragging Aux_DEC into tasking packages a tasking specific subtype is - -- defined here. - Task_Address_Size : constant := Standard'Address_Size; - -- The size of Task_Address + -- Type used for task addresses and its size Alternate_Stack_Size : constant := 0; -- No alternate signal stack is used on this platform diff --git a/gcc/ada/s-taspri-posix-noaltstack.ads b/gcc/ada/s-taspri-posix-noaltstack.ads index ac0e743af8f..a7708b2b300 100644 --- a/gcc/ada/s-taspri-posix-noaltstack.ads +++ b/gcc/ada/s-taspri-posix-noaltstack.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2011, AdaCore -- +-- Copyright (C) 1995-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- -- @@ -65,13 +65,8 @@ package System.Task_Primitives is -- Ada_Task_Control_Block. subtype Task_Address is System.Address; - -- In some versions of Task_Primitives, notably for VMS, Task_Address is - -- the short version of address defined in System.Aux_DEC. To avoid - -- dragging Aux_DEC into tasking packages a tasking specific subtype is - -- defined here. - Task_Address_Size : constant := Standard'Address_Size; - -- The size of Task_Address + -- Type used for task addresses and its size Alternate_Stack_Size : constant := 0; -- No alternate signal stack is used on this platform diff --git a/gcc/ada/s-taspri-posix.ads b/gcc/ada/s-taspri-posix.ads index 2fa27fdbde3..7eb0781569d 100644 --- a/gcc/ada/s-taspri-posix.ads +++ b/gcc/ada/s-taspri-posix.ads @@ -64,13 +64,8 @@ package System.Task_Primitives is -- Ada_Task_Control_Block. subtype Task_Address is System.Address; - -- In some versions of Task_Primitives, notably for VMS, Task_Address is - -- the short version of address defined in System.Aux_DEC. To avoid - -- dragging Aux_DEC into tasking packages a tasking specific subtype is - -- defined here. - Task_Address_Size : constant := Standard'Address_Size; - -- The size of Task_Address + -- Type used for task addresses and its size Alternate_Stack_Size : constant := System.OS_Interface.Alternate_Stack_Size; -- Import value from System.OS_Interface diff --git a/gcc/ada/s-taspri-solaris.ads b/gcc/ada/s-taspri-solaris.ads index 0c9c43267fc..6b2df7ff31f 100644 --- a/gcc/ada/s-taspri-solaris.ads +++ b/gcc/ada/s-taspri-solaris.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -70,13 +70,8 @@ package System.Task_Primitives is -- Ada_Task_Control_Block. subtype Task_Address is System.Address; - -- In some versions of Task_Primitives, notably for VMS, Task_Address is - -- the short version of address defined in System.Aux_DEC. To avoid - -- dragging Aux_DEC into tasking packages a tasking specific subtype is - -- defined here. - Task_Address_Size : constant := Standard'Address_Size; - -- The size of Task_Address + -- Type used for task addresses and its size Alternate_Stack_Size : constant := 0; -- No alternate signal stack is used on this platform diff --git a/gcc/ada/s-taspri-vxworks.ads b/gcc/ada/s-taspri-vxworks.ads index 9b67dd91c28..4e3eba5fc45 100644 --- a/gcc/ada/s-taspri-vxworks.ads +++ b/gcc/ada/s-taspri-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -61,13 +61,8 @@ package System.Task_Primitives is -- Ada_Task_Control_Block. subtype Task_Address is System.Address; - -- In some versions of Task_Primitives, notably for VMS, Task_Address is - -- the short version of address defined in System.Aux_DEC. To avoid - -- dragging Aux_DEC into tasking packages a tasking specific subtype is - -- defined here. - Task_Address_Size : constant := Standard'Address_Size; - -- The size of Task_Address + -- Type used for task addresses and its size Alternate_Stack_Size : constant := 0; -- No alternate signal stack is used on this platform diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d1f712ad1ab..792757065d6 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1140,9 +1140,7 @@ package body Sem_Ch12 is -- Propagate visible entity to operator node, either from a -- given actual or from a default. - if Is_Entity_Name (Actual) - and then Nkind (Expr) in N_Op - then + if Is_Entity_Name (Actual) and then Nkind (Expr) in N_Op then Set_Entity (Expr, Entity (Actual)); end if; @@ -1681,7 +1679,6 @@ package body Sem_Ch12 is if Present (Match) and then Nkind (Match) = N_Operator_Symbol then - -- If the name is a default, find its visible -- entity at the point of instantiation. @@ -10400,8 +10397,7 @@ package body Sem_Ch12 is -- to be compiled with checks off. -- Note that we do NOT apply this criterion to children of GNAT - -- (or on VMS, children of DEC). The latter units must suppress - -- checks explicitly if this is needed. + -- The latter units must suppress checks explicitly if needed. if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Gen_Decl))) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 7cbf593ab0f..d5573273e87 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3187,10 +3187,9 @@ package body Sem_Ch4 is then -- The actual can be compatible with the formal, but we must -- also check that the context is not an address type that is - -- visibly an integer type, as is the case in VMS_64. In this - -- case the use of literals is illegal, except in the body of - -- descendents of system, where arithmetic operations on - -- address are of course used. + -- visibly an integer type. In this case the use of literals is + -- illegal, except in the body of descendents of system, where + -- arithmetic operations on address are of course used. if Has_Compatible_Type (Actual, Etype (Formal)) and then @@ -6807,9 +6806,8 @@ package body Sem_Ch4 is -- Remove interpretations that treat literals as addresses. This -- is never appropriate, even when Address is defined as a visible -- Integer type. The reason is that we would really prefer Address - -- to behave as a private type, even in this case, which is there - -- only to accommodate oddities of VMS address sizes. If Address - -- is a visible integer type, we get lots of overload ambiguities. + -- to behave as a private type, even in this case. If Address is a + -- visible integer type, we get lots of overload ambiguities. if Nkind (N) in N_Binary_Op then declare diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 56db2bcc7b2..1e55e331710 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1698,6 +1698,28 @@ package body Sem_Ch5 is Typ : Entity_Id; Bas : Entity_Id; + procedure Check_Reverse_Iteration (Typ : Entity_Id); + -- For an iteration over a container, if the loop carries the Reverse + -- indicator, verify that the container type has an Iterate aspect that + -- implements the reversible iterator interface. + + ----------------------------- + -- Check_Reverse_Iteration -- + ----------------------------- + + procedure Check_Reverse_Iteration (Typ : Entity_Id) is + begin + if Reverse_Present (N) + and then not Is_Array_Type (Typ) + and then not Is_Reversible_Iterator (Typ) + then + Error_Msg_NE + ("container type does not support reverse iteration", N, Typ); + end if; + end Check_Reverse_Iteration; + + -- Start of processing for Analyze_iterator_Specification + begin Enter_Name (Def_Id); @@ -1725,6 +1747,45 @@ package body Sem_Ch5 is if Of_Present (N) then Set_Related_Expression (Def_Id, Iter_Name); + + -- For a container, the iterator is specified through the aspect. + + if not Is_Array_Type (Etype (Iter_Name)) then + declare + Iterator : constant Entity_Id := + Find_Value_Of_Aspect + (Etype (Iter_Name), Aspect_Default_Iterator); + I : Interp_Index; + It : Interp; + + begin + if No (Iterator) then + null; -- error reported below. + + elsif not Is_Overloaded (Iterator) then + Check_Reverse_Iteration (Etype (Iterator)); + + -- If Iterator is overloaded, use reversible iterator if + -- one is available. + + elsif Is_Overloaded (Iterator) then + Get_First_Interp (Iterator, I, It); + while Present (It.Nam) loop + if Ekind (It.Nam) = E_Function + and then Is_Reversible_Iterator (Etype (It.Nam)) + then + Set_Etype (Iterator, It.Typ); + Set_Entity (Iterator, It.Nam); + exit; + end if; + + Get_Next_Interp (I, It); + end loop; + + Check_Reverse_Iteration (Etype (Iterator)); + end if; + end; + end if; end if; -- If the domain of iteration is an expression, create a declaration for @@ -1785,10 +1846,17 @@ package body Sem_Ch5 is return; end if; + if not Of_Present (N) then + Check_Reverse_Iteration (Typ); + end if; + -- The name in the renaming declaration may be a function call. -- Indicate that it does not come from source, to suppress -- spurious warnings on renamings of parameterless functions, -- a common enough idiom in user-defined iterators. + -- The entity of the renaming must be a variable, because user- + -- defined Iterate function may have in-out parameters, even + -- if predefined ones do not. Decl := Make_Object_Renaming_Declaration (Loc, @@ -1801,6 +1869,7 @@ package body Sem_Ch5 is Rewrite (Name (N), New_Occurrence_Of (Id, Loc)); Set_Etype (Id, Typ); Set_Etype (Name (N), Typ); + Set_Ekind (Id, E_Variable); end; -- Container is an entity or an array with uncontrolled components, or @@ -1846,6 +1915,10 @@ package body Sem_Ch5 is else Resolve (Iter_Name, Etype (Iter_Name)); end if; + + if not Of_Present (N) then + Check_Reverse_Iteration (Etype (Iter_Name)); + end if; end if; -- Get base type of container, for proper retrieval of Cursor type diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 62421896565..640aaa67341 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -1668,13 +1668,6 @@ package body Sem_Eval is N_Null) then return True; - - -- Any reference to Null_Parameter is known at compile time. No - -- other attribute references (that have not already been folded) - -- are known at compile time. - - elsif K = N_Attribute_Reference then - return Attribute_Name (Op) = Name_Null_Parameter; end if; end if; @@ -2657,11 +2650,7 @@ package body Sem_Eval is Right_Int : constant Uint := Expr_Value (Right); begin - -- VMS includes bitwise operations on signed types - - if Is_Modular_Integer_Type (Etype (N)) - or else Is_VMS_Operator (Entity (N)) - then + if Is_Modular_Integer_Type (Etype (N)) then declare Left_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1); Right_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1); @@ -4035,13 +4024,6 @@ package body Sem_Eval is pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N)))); return Corresponding_Integer_Value (N); - -- Peculiar VMS case, if we have xxx'Null_Parameter, return zero - - elsif Kind = N_Attribute_Reference - and then Attribute_Name (N) = Name_Null_Parameter - then - return Uint_0; - -- Otherwise must be character literal else @@ -4114,13 +4096,6 @@ package body Sem_Eval is pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N)))); Val := Corresponding_Integer_Value (N); - -- Peculiar VMS case, if we have xxx'Null_Parameter, return zero - - elsif Kind = N_Attribute_Reference - and then Attribute_Name (N) = Name_Null_Parameter - then - Val := Uint_0; - -- Otherwise must be character literal else @@ -4182,18 +4157,12 @@ package body Sem_Eval is elsif Kind = N_Integer_Literal then return UR_From_Uint (Expr_Value (N)); - -- Peculiar VMS case, if we have xxx'Null_Parameter, return 0.0 + -- Here, we have a node that cannot be interpreted as a compile time + -- constant. That is definitely an error. - elsif Kind = N_Attribute_Reference - and then Attribute_Name (N) = Name_Null_Parameter - then - return Ureal_0; + else + raise Program_Error; end if; - - -- If we fall through, we have a node that cannot be interpreted as a - -- compile time constant. That is definitely an error. - - raise Program_Error; end Expr_Value_R; ------------------ diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index fe934840712..f61b47aed94 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -38,7 +38,6 @@ with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; -with Targparm; use Targparm; with Uintp; use Uintp; package body Sem_Intr is @@ -146,12 +145,6 @@ package body Sem_Intr is elsif String_Length (Strval (Expr_Value_S (Arg1))) = 0 then Error_Msg_NE ("call to & does not permit null string", N, Nam); - - elsif OpenVMS_On_Target - and then String_Length (Strval (Expr_Value_S (Arg1))) > 31 - then - Error_Msg_NE - ("argument in call to & must be 31 characters or less", N, Nam); end if; -- Check for the case of freeing a non-null object which will raise diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index be7eff31cb1..e37aefab020 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -23,16 +23,14 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Einfo; use Einfo; -with Errout; use Errout; -with Namet; use Namet; -with Sem; use Sem; -with Sem_Aux; use Sem_Aux; -with Sinfo; use Sinfo; -with Snames; use Snames; -with Stand; use Stand; -with Targparm; use Targparm; +with Atree; use Atree; +with Einfo; use Einfo; +with Errout; use Errout; +with Namet; use Namet; +with Sem; use Sem; +with Sem_Aux; use Sem_Aux; +with Sinfo; use Sinfo; +with Snames; use Snames; package body Sem_Mech is @@ -93,18 +91,10 @@ package body Sem_Mech is Mech : Mechanism_Type; Enod : Node_Id) is - begin - -- Right now we only do some checks for functions returning arguments - -- by descriptor. Probably mode checks need to be added here ??? - - if Mech in Descriptor_Codes and then not Is_Formal (Ent) then - if Is_Record_Type (Etype (Ent)) then - Error_Msg_N ("??records cannot be returned by Descriptor", Enod); - return; - end if; - end if; + pragma Unreferenced (Enod); - -- If we fall through, all checks have passed + begin + -- Right now we don't do any checks, should we do more ??? Set_Mechanism (Ent, Mech); end Set_Mechanism_With_Checks; @@ -314,23 +304,10 @@ package body Sem_Mech is when Convention_Fortran => - -- In OpenVMS, pass character and string types using - -- Short_Descriptor(S) - - if OpenVMS_On_Target - and then (Root_Type (Typ) = Standard_Character - or else - (Is_Array_Type (Typ) - and then - Root_Type (Component_Type (Typ)) = - Standard_Character)) - then - Set_Mechanism (Formal, By_Short_Descriptor_S); - -- Access types are passed by default (presumably this -- will mean they are passed by copy) - elsif Is_Access_Type (Typ) then + if Is_Access_Type (Typ) then null; -- For now, we pass all other parameters by reference. diff --git a/gcc/ada/sem_mech.ads b/gcc/ada/sem_mech.ads index 3e74a2c2fa2..464c9bd9e75 100644 --- a/gcc/ada/sem_mech.ads +++ b/gcc/ada/sem_mech.ads @@ -87,46 +87,9 @@ package Sem_Mech is -- special information) is determined by the backend in accordance with -- requirements imposed by the ABI as interpreted for Ada. - By_Descriptor : constant Mechanism_Type := -3; - By_Descriptor_UBS : constant Mechanism_Type := -4; - By_Descriptor_UBSB : constant Mechanism_Type := -5; - By_Descriptor_UBA : constant Mechanism_Type := -6; - By_Descriptor_S : constant Mechanism_Type := -7; - By_Descriptor_SB : constant Mechanism_Type := -8; - By_Descriptor_A : constant Mechanism_Type := -9; - By_Descriptor_NCA : constant Mechanism_Type := -10; - By_Short_Descriptor : constant Mechanism_Type := -11; - By_Short_Descriptor_UBS : constant Mechanism_Type := -12; - By_Short_Descriptor_UBSB : constant Mechanism_Type := -13; - By_Short_Descriptor_UBA : constant Mechanism_Type := -14; - By_Short_Descriptor_S : constant Mechanism_Type := -15; - By_Short_Descriptor_SB : constant Mechanism_Type := -16; - By_Short_Descriptor_A : constant Mechanism_Type := -17; - By_Short_Descriptor_NCA : constant Mechanism_Type := -18; - -- These values are used only in OpenVMS ports of GNAT. Pass by descriptor - -- is forced, as described in the OpenVMS ABI. The suffix indicates the - -- descriptor type: - -- - -- UBS unaligned bit string - -- UBSB aligned bit string with arbitrary bounds - -- UBA unaligned bit array - -- S string, also a scalar or access type parameter - -- SB string with arbitrary bounds - -- A contiguous array - -- NCA non-contiguous array - -- - -- Note: the form with no suffix is used if the Import/Export pragma uses - -- the simple form of the mechanism name (no descriptor type is supplied). - -- In this case the back end assigns a descriptor type based on the Ada - -- type in accordance with the OpenVMS ABI. - - pragma Assert (Mechanism_Type'First = -18); + pragma Assert (Mechanism_Type'First = -2); -- Check definition in types is right! - subtype Descriptor_Codes is Mechanism_Type - range By_Short_Descriptor_NCA .. By_Descriptor; - -- Subtype including all descriptor mechanisms - -- All the above special values are non-positive. Positive values for -- Mechanism_Type values have a special meaning. They are used only in -- the case of records, as a result of the use of the C_Pass_By_Copy diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index ac5d494719a..54f8f230fa6 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7312,13 +7312,16 @@ package body Sem_Prag is Arg_Result_Mechanism : Node_Id := Empty; Arg_First_Optional_Parameter : 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; Formal : Entity_Id; Ambiguous : Boolean; Match : Boolean; - Dval : Node_Id; function Same_Base_Type (Ptype : Node_Id; @@ -7699,63 +7702,6 @@ package body Sem_Prag is end if; end; end if; - - -- Process First_Optional_Parameter argument if present. We have - -- already checked that this is only allowed for the Import case. - - if Present (Arg_First_Optional_Parameter) then - if Nkind (Arg_First_Optional_Parameter) /= N_Identifier then - Error_Pragma_Arg - ("first optional parameter must be formal parameter name", - Arg_First_Optional_Parameter); - end if; - - Formal := First_Formal (Ent); - loop - if No (Formal) then - Error_Pragma_Arg - ("specified formal parameter& not found", - Arg_First_Optional_Parameter); - end if; - - exit when Chars (Formal) = - Chars (Arg_First_Optional_Parameter); - - Next_Formal (Formal); - end loop; - - Set_First_Optional_Parameter (Ent, Formal); - - -- Check specified and all remaining formals have right form - - while Present (Formal) loop - if Ekind (Formal) /= E_In_Parameter then - Error_Msg_NE - ("optional formal& is not of mode in!", - Arg_First_Optional_Parameter, Formal); - - else - Dval := Default_Value (Formal); - - if No (Dval) then - Error_Msg_NE - ("optional formal& does not have default value!", - Arg_First_Optional_Parameter, Formal); - - elsif Compile_Time_Known_Value_Or_Aggr (Dval) then - null; - - else - Error_Msg_FE - ("default value for optional formal& is non-static!", - Arg_First_Optional_Parameter, Formal); - end if; - end if; - - Set_Is_Optional_Parameter (Formal); - Next_Formal (Formal); - end loop; - end if; end Process_Extended_Import_Export_Subprogram_Pragma; -------------------------- @@ -10847,10 +10793,9 @@ package body Sem_Prag is Check_Arg_Count (0); -- If Address is a private type, then set the flag to allow - -- integer address values. If Address is not private, then - -- this pragma has no purpose, so it is simply ignored. Not - -- clear if there are any such targets now (VMS used to be - -- one such, but leave test in for the future anyway). + -- integer address values. If Address is not private, then this + -- pragma has no purpose, so it is simply ignored. Not clear if + -- there are any such targets now. if Opt.Address_Is_Private then Opt.Allow_Integer_Address := True; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d7097e2ddce..38e25f01ee1 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -225,8 +225,7 @@ package body Sem_Res is -- operators, not ones that are intrinsic imports of back-end builtins. procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id); - -- Ditto, for unary operators (arithmetic ones and "not" on signed - -- integer types for VMS). + -- Ditto, for arithmetic unary operators procedure Rewrite_Operator_As_Call (N : Node_Id; Nam : Entity_Id); -- If an operator node resolves to a call to a user-defined operator, @@ -7990,11 +7989,10 @@ package body Sem_Res is -------------------------------- procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id) is - Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ)); - Op : Entity_Id; - Orig_Op : constant Entity_Id := Entity (N); - Arg1 : Node_Id; - Arg2 : Node_Id; + Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ)); + Op : Entity_Id; + Arg1 : Node_Id; + Arg2 : Node_Id; function Convert_Operand (Opnd : Node_Id) return Node_Id; -- If the operand is a literal, it cannot be the expression in a @@ -8074,31 +8072,19 @@ package body Sem_Res is or else Typ /= Etype (Right_Opnd (N)) then -- Add explicit conversion where needed, and save interpretations in - -- case operands are overloaded. If the context is a VMS operation, - -- assert that the conversion is legal (the operands have the proper - -- types to select the VMS intrinsic). Note that in rare cases the - -- VMS operators may be visible, but the default System is being used - -- and Address is a private type. + -- case operands are overloaded. Arg1 := Convert_To (Typ, Left_Opnd (N)); Arg2 := Convert_To (Typ, Right_Opnd (N)); if Nkind (Arg1) = N_Type_Conversion then Save_Interps (Left_Opnd (N), Expression (Arg1)); - - if Is_VMS_Operator (Orig_Op) then - Set_Conversion_OK (Arg1); - end if; else Save_Interps (Left_Opnd (N), Arg1); end if; if Nkind (Arg2) = N_Type_Conversion then Save_Interps (Right_Opnd (N), Expression (Arg2)); - - if Is_VMS_Operator (Orig_Op) then - Set_Conversion_OK (Arg2); - end if; else Save_Interps (Right_Opnd (N), Arg2); end if; @@ -8170,18 +8156,13 @@ package body Sem_Res is B_Typ := Base_Type (Typ); end if; - -- OK if this is a VMS-specific intrinsic operation - - if Is_VMS_Operator (Entity (N)) then - null; - -- The following test is required because the operands of the operation -- may be literals, in which case the resulting type appears to be -- compatible with a signed integer type, when in fact it is compatible -- only with modular types. If the context itself is universal, the -- operation is illegal. - elsif not Valid_Boolean_Arg (Typ) then + if not Valid_Boolean_Arg (Typ) then Error_Msg_N ("invalid context for logical operation", N); Set_Etype (N, Any_Type); return; @@ -8934,12 +8915,9 @@ package body Sem_Res is B_Typ := Base_Type (Typ); end if; - if Is_VMS_Operator (Entity (N)) then - null; - -- Straightforward case of incorrect arguments - elsif not Valid_Boolean_Arg (Typ) then + if not Valid_Boolean_Arg (Typ) then Error_Msg_N ("invalid operand type for operator&", N); Set_Etype (N, Any_Type); return; @@ -11098,15 +11076,15 @@ package body Sem_Res is if Is_Floating_Point_Type (Opnd_Typ) and then (Is_Integer_Type (Target_Typ) - or else (Is_Fixed_Point_Type (Target_Typ) - and then Conversion_OK (N))) + or else (Is_Fixed_Point_Type (Target_Typ) + and then Conversion_OK (N))) and then Nkind (Operand) = N_Attribute_Reference - and then (Attribute_Name (Operand) = Name_Rounding - or else Attribute_Name (Operand) = Name_Truncation) + and then Nam_In (Attribute_Name (Operand), Name_Rounding, + Name_Truncation) then declare Truncate : constant Boolean := - Attribute_Name (Operand) = Name_Truncation; + Attribute_Name (Operand) = Name_Truncation; begin Rewrite (Operand, Relocate_Node (First (Expressions (Operand)))); @@ -11515,13 +11493,6 @@ package body Sem_Res is -- this context, but which cannot be removed by type checking, -- because the context does not impose a type. - -- When compiling for VMS, spurious ambiguities can be produced - -- when arithmetic operations have a literal operand and return - -- System.Address or a descendant of it. These ambiguities are - -- otherwise resolved by the context, but for conversions there - -- is no context type and the removal of the spurious operations - -- must be done explicitly here. - -- The node may be labelled overloaded, but still contain only one -- interpretation because others were discarded earlier. If this -- is the case, retain the single interpretation if legal. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7fbf48a8461..f460898e5de 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6022,8 +6022,7 @@ package body Sem_Util is -- be a static subtype, since otherwise it would have -- been diagnosed as illegal. - elsif Is_Entity_Name (Choice) and then - Is_Type (Entity (Choice)) + elsif Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)) then exit Search when Is_In_Range (Expr, Etype (Choice), Assume_Valid => False); @@ -11798,25 +11797,6 @@ package body Sem_Util is return False; end Is_Variable_Size_Record; - --------------------- - -- Is_VMS_Operator -- - --------------------- - - function Is_VMS_Operator (Op : Entity_Id) return Boolean is - begin - -- The VMS operators are declared in a child of System that is loaded - -- through pragma Extend_System. In some rare cases a program is run - -- with this extension but without indicating that the target is VMS. - - return Ekind (Op) = E_Function - and then Is_Intrinsic_Subprogram (Op) - and then - ((Present_System_Aux and then Scope (Op) = System_Aux_Id) - or else - (True_VMS_Target - and then Scope (Scope (Op)) = RTU_Entity (System))); - end Is_VMS_Operator; - ----------------- -- Is_Variable -- ----------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index e59cc892e25..a3b8cb4fc36 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1359,10 +1359,6 @@ package Sem_Util is function Is_Variable_Size_Record (E : Entity_Id) return Boolean; -- Returns true if E has variable size components - function Is_VMS_Operator (Op : Entity_Id) return Boolean; - -- Determine whether an operator is one of the intrinsics defined - -- in the DEC system extension. - function Is_Variable (N : Node_Id; Use_Original_Node : Boolean := True) return Boolean; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 19ccec40749..ccbf87c58a9 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -2488,15 +2488,6 @@ package body Sinfo is return List3 (N); end Parameter_Associations; - function Parameter_List_Truncated - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - return Flag17 (N); - end Parameter_List_Truncated; - function Parameter_Specifications (N : Node_Id) return List_Id is begin @@ -5695,15 +5686,6 @@ package body Sinfo is Set_List3_With_Parent (N, Val); end Set_Parameter_Associations; - procedure Set_Parameter_List_Truncated - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - Set_Flag17 (N, Val); - end Set_Parameter_List_Truncated; - procedure Set_Parameter_Specifications (N : Node_Id; Val : List_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 841f2c7fda0..9f20397b32f 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1888,21 +1888,6 @@ package Sinfo is -- list of discrete choices, except that of course it cannot contain an -- N_Others_Choice entry. - -- Parameter_List_Truncated (Flag17-Sem) - -- Present in N_Function_Call and N_Procedure_Call_Statement nodes. Set - -- (for OpenVMS ports of GNAT only) if the parameter list is truncated - -- as a result of a First_Optional_Parameter specification in one of the - -- pragmas Import_Function, Import_Procedure, or Import_Valued_Procedure. - -- The truncation is done by the expander by removing trailing parameters - -- from the argument list, in accordance with the set of rules allowing - -- such parameter removal. In particular, parameters can be removed - -- working from the end of the parameter list backwards up to and - -- including the entry designated by First_Optional_Parameter in the - -- Import pragma. Parameters can be removed if they are implicit and the - -- default value is known at compile time value, including the use of - -- the Null_Parameter attribute, or if explicit parameter values are - -- present that match the corresponding defaults. - -- Parent_Spec (Node4-Sem) -- For a library unit that is a child unit spec (package or subprogram -- declaration, generic declaration or instantiation, or library level @@ -5156,7 +5141,6 @@ package Sinfo is -- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching) -- Do_Tag_Check (Flag13-Sem) -- No_Elaboration_Check (Flag14-Sem) - -- Parameter_List_Truncated (Flag17-Sem) -- ABE_Is_Certain (Flag18-Sem) -- plus fields for expression @@ -5188,7 +5172,6 @@ package Sinfo is -- Is_Expanded_Build_In_Place_Call (Flag11-Sem) -- Do_Tag_Check (Flag13-Sem) -- No_Elaboration_Check (Flag14-Sem) - -- Parameter_List_Truncated (Flag17-Sem) -- ABE_Is_Certain (Flag18-Sem) -- plus fields for expression @@ -9433,9 +9416,6 @@ package Sinfo is function Parameter_Associations (N : Node_Id) return List_Id; -- List3 - function Parameter_List_Truncated - (N : Node_Id) return Boolean; -- Flag17 - function Parameter_Specifications (N : Node_Id) return List_Id; -- List3 @@ -10456,9 +10436,6 @@ package Sinfo is procedure Set_Parameter_Associations (N : Node_Id; Val : List_Id); -- List3 - procedure Set_Parameter_List_Truncated - (N : Node_Id; Val : Boolean := True); -- Flag17 - procedure Set_Parameter_Specifications (N : Node_Id; Val : List_Id); -- List3 @@ -12719,7 +12696,6 @@ package Sinfo is pragma Inline (Out_Present); pragma Inline (Parameter_Associations); pragma Inline (Parameter_Specifications); - pragma Inline (Parameter_List_Truncated); pragma Inline (Parameter_Type); pragma Inline (Parent_Spec); pragma Inline (Position); @@ -13055,7 +13031,6 @@ package Sinfo is pragma Inline (Set_Others_Discrete_Choices); pragma Inline (Set_Out_Present); pragma Inline (Set_Parameter_Associations); - pragma Inline (Set_Parameter_List_Truncated); pragma Inline (Set_Parameter_Specifications); pragma Inline (Set_Parameter_Type); pragma Inline (Set_Parent_Spec); diff --git a/gcc/ada/sinput-c.adb b/gcc/ada/sinput-c.adb index 06c501bef25..6c3d58254fe 100644 --- a/gcc/ada/sinput-c.adb +++ b/gcc/ada/sinput-c.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- -- @@ -92,8 +92,8 @@ package body Sinput.C is Len := Integer (File_Length (Source_File_FD)); - -- Set Hi so that length is one more than the physical length, - -- allowing for the extra EOF character at the end of the buffer + -- Set Hi so that length is one more than the physical length, allowing + -- for the extra EOF character at the end of the buffer Hi := Lo + Source_Ptr (Len); @@ -112,9 +112,9 @@ package body Sinput.C is begin -- Allocate source buffer, allowing extra character at end for EOF - -- Some systems (e.g. VMS) have file types that require one - -- read per line, so read until we get the Len bytes or until - -- there are no more characters. + -- Some systems have file types that require one read per line, + -- so read until we get the Len bytes or until there are no more + -- characters. Hi := Lo; loop @@ -126,8 +126,8 @@ package body Sinput.C is Actual_Ptr (Hi) := EOF; -- Now we need to work out the proper virtual origin pointer to - -- return. This is exactly Actual_Ptr (0)'Address, but we have - -- to be careful to suppress checks to compute this address. + -- return. This is exactly Actual_Ptr (0)'Address, but we have to + -- be careful to suppress checks to compute this address. declare pragma Suppress (All_Checks); diff --git a/gcc/ada/symbols.ads b/gcc/ada/symbols.ads index 65954dc8b76..a1d24576839 100644 --- a/gcc/ada/symbols.ads +++ b/gcc/ada/symbols.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -91,10 +91,9 @@ package Symbols is package Processing is - -- This package, containing a single visible procedure Process, exists so - -- that it can be a subunits, for some platforms (such as VMS Alpha and - -- IA64), the body of package Symbols is common, while the subunit - -- Processing is not. + -- This package, containing a single visible procedure Process, exists + -- so that it can be a subunits, for some platforms, the body of package + -- Symbols is common, while the subunit Processing is not. procedure Process (Object_File : String; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 0f93344ef37..b161466c417 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -716,13 +716,6 @@ package body Targparm is end if; end loop Line_Loop; - -- Now that OpenVMS_On_Target has been given its definitive value, - -- change the multi-unit index character from '~' to '$' for OpenVMS. - - if OpenVMS_On_Target then - Multi_Unit_Index_Character := '$'; - end if; - if Fatal then raise Unrecoverable_Error; end if; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 964d39ccfb2..0f21b9973c0 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -603,49 +603,18 @@ package body Treepr is begin case M is - when Default_Mechanism - => Write_Str ("Default"); - when By_Copy - => Write_Str ("By_Copy"); - when By_Reference - => Write_Str ("By_Reference"); - when By_Descriptor - => Write_Str ("By_Descriptor"); - when By_Descriptor_UBS - => Write_Str ("By_Descriptor_UBS"); - when By_Descriptor_UBSB - => Write_Str ("By_Descriptor_UBSB"); - when By_Descriptor_UBA - => Write_Str ("By_Descriptor_UBA"); - when By_Descriptor_S - => Write_Str ("By_Descriptor_S"); - when By_Descriptor_SB - => Write_Str ("By_Descriptor_SB"); - when By_Descriptor_A - => Write_Str ("By_Descriptor_A"); - when By_Descriptor_NCA - => Write_Str ("By_Descriptor_NCA"); - when By_Short_Descriptor - => Write_Str ("By_Short_Descriptor"); - when By_Short_Descriptor_UBS - => Write_Str ("By_Short_Descriptor_UBS"); - when By_Short_Descriptor_UBSB - => Write_Str ("By_Short_Descriptor_UBSB"); - when By_Short_Descriptor_UBA - => Write_Str ("By_Short_Descriptor_UBA"); - when By_Short_Descriptor_S - => Write_Str ("By_Short_Descriptor_S"); - when By_Short_Descriptor_SB - => Write_Str ("By_Short_Descriptor_SB"); - when By_Short_Descriptor_A - => Write_Str ("By_Short_Descriptor_A"); - when By_Short_Descriptor_NCA - => Write_Str ("By_Short_Descriptor_NCA"); + when Default_Mechanism => + Write_Str ("Default"); + + when By_Copy => + Write_Str ("By_Copy"); + + when By_Reference => + Write_Str ("By_Reference"); when 1 .. Mechanism_Type'Last => Write_Str ("By_Copy if size <= "); Write_Int (Int (M)); - end case; end; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 0070c6c20a9..d723248821e 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -795,11 +795,11 @@ package Types is -- mechanism. See specification of Sem_Mech for full details. The following -- subtype is used to represent values of this type: - subtype Mechanism_Type is Int range -18 .. Int'Last; + subtype Mechanism_Type is Int range -2 .. Int'Last; -- Type used to represent a mechanism value. This is a subtype rather than -- a type to avoid some annoying processing problems with certain routines -- in Einfo (processing them to create the corresponding C). The values in - -- the range -18 .. 0 are used to represent mechanism types declared as + -- the range -2 .. 0 are used to represent mechanism types declared as -- named constants in the spec of Sem_Mech. Positive values are used for -- the case of a pragma C_Pass_By_Copy that sets a threshold value for the -- mechanism to be used. For example if pragma C_Pass_By_Copy (32) is given diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb index 4b82b035e99..25a775f93c0 100644 --- a/gcc/ada/xr_tabls.adb +++ b/gcc/ada/xr_tabls.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2013, 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- -- @@ -25,7 +25,6 @@ with Types; use Types; with Osint; -with Hostparm; with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; @@ -1136,17 +1135,6 @@ package body Xr_Tabls is Buffer (Read_Ptr) := EOF; Contents := new String'(Buffer (1 .. Read_Ptr)); - - -- Things are not simple on VMS due to the plethora of file types - -- and organizations. It seems clear that there shouldn't be more - -- bytes read than are contained in the file though. - - if (Hostparm.OpenVMS and then Read_Ptr > Length + 1) - or else (not Hostparm.OpenVMS and then Read_Ptr /= Length + 1) - then - raise Ada.Text_IO.End_Error; - end if; - Close (FD); end; end Read_File; diff --git a/gcc/ada/xr_tabls.ads b/gcc/ada/xr_tabls.ads index b328b82b903..03949ced0bf 100644 --- a/gcc/ada/xr_tabls.ads +++ b/gcc/ada/xr_tabls.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2012, 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- -- @@ -288,9 +288,7 @@ package Xr_Tabls is -- character will be added to the returned Contents to simplify parsing. -- Name_Error is raised if the file was not found. End_Error is raised if -- the file could not be read correctly. For most systems correct reading - -- means that the number of bytes read is equal to the file size. The - -- exception is OpenVMS where correct reading means that the number of - -- bytes read is less than or equal to the file size. + -- means that the number of bytes read is equal to the file size. private type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record |