diff options
author | Arnaud Charlet <charlet@adacore.com> | 2014-08-01 08:12:27 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-01 10:12:27 +0200 |
commit | 62883e6b17b85341fbc9b35c51bc076d39dcec23 (patch) | |
tree | 8b274633bd4a9796bb8f946cf618a08545de0628 /gcc/ada | |
parent | 148c744a1789b29b3c3c32b45ea3be913fef6a52 (diff) | |
download | gcc-62883e6b17b85341fbc9b35c51bc076d39dcec23.zip gcc-62883e6b17b85341fbc9b35c51bc076d39dcec23.tar.gz gcc-62883e6b17b85341fbc9b35c51bc076d39dcec23.tar.bz2 |
binde.adb, [...]: Remove VMS handling.
2014-08-01 Arnaud Charlet <charlet@adacore.com>
* binde.adb, bindgen.adb, butil.adb, clean.adb, gnatbind.adb,
gnatchop.adb, gnatcmd.adb, gnatls.adb, gnatname.adb, krunch.adb,
make.adb, makeutl.adb, memtrack.adb, mlib-prj.adb, mlib.adb,
mlib.ads, tempdir.adb: Remove VMS handling.
From-SVN: r213413
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/ada/binde.adb | 10 | ||||
-rw-r--r-- | gcc/ada/bindgen.adb | 94 | ||||
-rw-r--r-- | gcc/ada/butil.adb | 14 | ||||
-rw-r--r-- | gcc/ada/clean.adb | 44 | ||||
-rw-r--r-- | gcc/ada/gnatbind.adb | 19 | ||||
-rw-r--r-- | gcc/ada/gnatchop.adb | 101 | ||||
-rw-r--r-- | gcc/ada/gnatcmd.adb | 293 | ||||
-rw-r--r-- | gcc/ada/gnatls.adb | 16 | ||||
-rw-r--r-- | gcc/ada/gnatname.adb | 52 | ||||
-rw-r--r-- | gcc/ada/krunch.adb | 8 | ||||
-rw-r--r-- | gcc/ada/make.adb | 110 | ||||
-rw-r--r-- | gcc/ada/makeutl.adb | 7 | ||||
-rw-r--r-- | gcc/ada/memtrack.adb | 1 | ||||
-rw-r--r-- | gcc/ada/mlib-prj.adb | 64 | ||||
-rw-r--r-- | gcc/ada/mlib.adb | 11 | ||||
-rw-r--r-- | gcc/ada/mlib.ads | 5 | ||||
-rw-r--r-- | gcc/ada/tempdir.adb | 24 |
18 files changed, 251 insertions, 629 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2248f1d..28cde03 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2014-08-01 Arnaud Charlet <charlet@adacore.com> + + * binde.adb, bindgen.adb, butil.adb, clean.adb, gnatbind.adb, + gnatchop.adb, gnatcmd.adb, gnatls.adb, gnatname.adb, krunch.adb, + make.adb, makeutl.adb, memtrack.adb, mlib-prj.adb, mlib.adb, + mlib.ads, tempdir.adb: Remove VMS handling. + 2014-08-01 Pascal Obry <obry@adacore.com> * adaint.h, adaint.c (__gnat_file_length): Returns an __int64. diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index 935e09e..f22e53b 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.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- -- @@ -31,7 +31,6 @@ with Namet; use Namet; with Opt; use Opt; with Osint; with Output; use Output; -with Targparm; use Targparm; with System.Case_Util; use System.Case_Util; @@ -1089,12 +1088,7 @@ package body Binde is if Pessimistic_Elab_Order and not Dynamic_Elaboration_Checks_Specified then - if OpenVMS_On_Target then - Error_Msg ("?use of /PESSIMISTIC_ELABORATION questionable"); - else - Error_Msg ("?use of -p switch questionable"); - end if; - + Error_Msg ("?use of -p switch questionable"); Error_Msg ("?since all units compiled with static elaboration model"); end if; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 8d5262b..6363e1b 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -52,10 +52,6 @@ package body Bindgen is Last : Natural := 0; -- Last location in Statement_Buffer currently set - With_DECGNAT : Boolean := False; - -- Flag which indicates whether the program uses the DECGNAT library - -- (presence of the unit DEC). - With_GNARL : Boolean := False; -- Flag which indicates whether the program uses the GNARL library -- (presence of the unit System.OS_Interface) @@ -325,9 +321,7 @@ package body Bindgen is -- Move routine for sorting linker options procedure Resolve_Binder_Options; - -- Set the value of With_GNARL and With_DECGNAT. The latter only on VMS - -- since it tests for a package named "dec" which might cause a conflict - -- on non-VMS systems. + -- Set the value of With_GNARL. procedure Set_Char (C : Character); -- Set given character in Statement_Buffer at the Last + 1 position @@ -659,36 +653,6 @@ package body Bindgen is """__gnat_finalize_library_objects"");"); end if; - -- Import entry point for environment feature enable/disable - -- routine, and indication that it's been called previously. - - if OpenVMS_On_Target then - WBI (""); - WBI (" procedure Set_Features;"); - WBI (" pragma Import (C, Set_Features, " & - """__gnat_set_features"");"); - WBI (""); - WBI (" Features_Set : Integer;"); - WBI (" pragma Import (C, Features_Set, " & - """__gnat_features_set"");"); - - if Opt.Heap_Size /= 0 then - WBI (""); - WBI (" Heap_Size : Integer;"); - WBI (" pragma Import (C, Heap_Size, " & - """__gl_heap_size"");"); - - Write_Statement_Buffer; - end if; - - WBI (""); - WBI (" Float_Format : Character;"); - WBI (" pragma Import (C, Float_Format, " & - """__gl_float_format"");"); - - Write_Statement_Buffer; - end if; - -- Initialize stack limit variable of the environment task if the -- stack check method is stack limit and stack check is enabled. @@ -886,44 +850,6 @@ package body Bindgen is WBI (" Install_Handler;"); WBI (" end if;"); end if; - - -- Generate call to Set_Features - - if OpenVMS_On_Target then - - -- Set_Features will call IEEE$SET_FP_CONTROL appropriately - -- depending on the setting of Float_Format. - - WBI (""); - Set_String (" Float_Format := '"); - - if Float_Format_Specified = 'G' - or else - Float_Format_Specified = 'D' - then - Set_Char ('V'); - else - Set_Char ('I'); - end if; - - Set_String ("';"); - Write_Statement_Buffer; - - WBI (""); - WBI (" if Features_Set = 0 then"); - WBI (" Set_Features;"); - WBI (" end if;"); - - -- Features_Set may twiddle the heap size according to a logical - -- name, but the binder switch must override. - - if Opt.Heap_Size /= 0 then - Set_String (" Heap_Size := "); - Set_Int (Opt.Heap_Size); - Set_Char (';'); - Write_Statement_Buffer; - end if; - end if; end if; -- Generate call to set Initialize_Scalar values if active @@ -2138,18 +2064,6 @@ package body Bindgen is WBI (" -- " & Name_Buffer (1 .. Name_Len)); - if With_DECGNAT then - Name_Len := 0; - - if Opt.Shared_Libgnat then - Add_Str_To_Name_Buffer (Shared_Lib ("decgnat")); - else - Add_Str_To_Name_Buffer ("-ldecgnat"); - end if; - - Write_Linker_Option; - end if; - if With_GNARL then Name_Len := 0; @@ -3025,12 +2939,6 @@ package body Bindgen is Check_Package (With_GNARL, "system.os_interface%s"); - -- Ditto for declib and the "dec" package - - if OpenVMS_On_Target then - Check_Package (With_DECGNAT, "dec%s"); - end if; - -- Ditto for the use of restricted tasking Check_Package diff --git a/gcc/ada/butil.adb b/gcc/ada/butil.adb index 703d243..8ca4994 100644 --- a/gcc/ada/butil.adb +++ b/gcc/ada/butil.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- -- @@ -23,8 +23,7 @@ -- -- ------------------------------------------------------------------------------ -with Output; use Output; -with Targparm; use Targparm; +with Output; use Output; package body Butil is @@ -41,14 +40,7 @@ package body Butil is or else (Name_Len > 4 and then (Name_Buffer (1 .. 5) = "gnat%" or else - Name_Buffer (1 .. 5) = "gnat.")) - or else - (OpenVMS_On_Target - and then Name_Len > 3 - and then (Name_Buffer (1 .. 4) = "dec%" - or else - Name_Buffer (1 .. 4) = "dec.")); - + Name_Buffer (1 .. 5) = "gnat.")); end Is_Internal_Unit; ------------------------ diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 8b34433..a41729a 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -64,15 +64,12 @@ package body Clean is ALI_Suffix : constant String := ".ali"; Tree_Suffix : constant String := ".adt"; Object_Suffix : constant String := Get_Target_Object_Suffix.all; - Debug_Suffix : String := ".dg"; - -- Changed to "_dg" for VMS in the body of the package + Debug_Suffix : constant String := ".dg"; + Repinfo_Suffix : constant String := ".rep"; + -- Suffix of representation info files. - Repinfo_Suffix : String := ".rep"; - -- Changed to "_rep" for VMS in the body of the package - - B_Start : String_Ptr := new String'("b~"); + B_Start : constant String := "b~"; -- Prefix of binder generated file, and number of actual characters used. - -- Changed to "b__" for VMS in the body of the package. Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data (Is_Root_Tree => True); @@ -1266,27 +1263,7 @@ package body Clean is or else Is_Writable_File (Full_Name (1 .. Last)) or else Is_Symbolic_Link (Full_Name (1 .. Last)) then - -- On VMS, we have to delete all versions of the file - - if OpenVMS_On_Target then - declare - Host_Full_Name : constant String_Access := - To_Host_File_Spec (Full_Name (1 .. Last)); - begin - if Host_Full_Name = null - or else Host_Full_Name'Length = 0 - then - Success := False; - else - Delete_File (Host_Full_Name.all & ";*", Success); - end if; - end; - - -- Otherwise just delete the specified file - - else - Delete_File (Full_Name (1 .. Last), Success); - end if; + Delete_File (Full_Name (1 .. Last), Success); -- Here if no deletion required @@ -1327,7 +1304,7 @@ package body Clean is -- Build the file name (before the extension) - File_Name (1 .. B_Start'Length) := B_Start.all; + File_Name (1 .. B_Start'Length) := B_Start; File_Name (B_Start'Length + 1 .. Last) := Source_Name; -- Spec @@ -1590,16 +1567,7 @@ package body Clean is Prj.Tree.Initialize (Project_Node_Tree); Prj.Initialize (Project_Tree); - - -- Check if the platform is VMS and, if it is, change some variables - Targparm.Get_Target_Parameters; - - if OpenVMS_On_Target then - Debug_Suffix (Debug_Suffix'First) := '_'; - Repinfo_Suffix (Repinfo_Suffix'First) := '_'; - B_Start := new String'("b__"); - end if; end if; -- Reset global variables diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 6383e81..7cba0c6 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -77,8 +77,6 @@ procedure Gnatbind is Output_File_Name_Seen : Boolean := False; Output_File_Name : String_Ptr := new String'(""); - L_Switch_Seen : Boolean := False; - Mapping_File : String_Ptr := null; package Closure_Sources is new Table.Table @@ -338,12 +336,6 @@ procedure Gnatbind is elsif Argv (2) = 'L' then if Argv'Length >= 3 then - -- Remember that the -L switch was specified, so that if this - -- is on OpenVMS, the export names are put in uppercase. - -- This is not known before the target parameters are read. - - L_Switch_Seen := True; - Opt.Bind_For_Library := True; Opt.Ada_Init_Name := new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix); @@ -642,17 +634,6 @@ begin Cumulative_Restrictions := Targparm.Restrictions_On_Target; - -- On OpenVMS, when -L is used, all external names used in pragmas Export - -- are in upper case. The reason is that on OpenVMS, the macro-assembler - -- MACASM-32, used to build Stand-Alone Libraries, only understands - -- uppercase. - - if L_Switch_Seen and then OpenVMS_On_Target then - To_Upper (Opt.Ada_Init_Name.all); - To_Upper (Opt.Ada_Final_Name.all); - To_Upper (Opt.Ada_Main_Name.all); - end if; - -- Acquire configurable run-time mode if Configurable_Run_Time_On_Target then diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index d51e83a..6170f88 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -36,7 +36,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.Heap_Sort_G; with GNAT.Table; -with Hostparm; with Switch; use Switch; with Types; @@ -273,10 +272,7 @@ procedure Gnatchop is Success : out Boolean); -- Reads file associated with FS into the newly allocated -- string Contents. - -- [VMS] Success is true iff the number of bytes read is less than or - -- equal to the file size. - -- [Other] Success is true iff the number of bytes read is equal to - -- the file size. + -- Success is true iff the number of bytes read is equal to the file size. function Report_Duplicate_Units return Boolean; -- Output messages about duplicate units in the input files in Unit.Table @@ -387,15 +383,8 @@ procedure Gnatchop is begin if Is_Writable_File (Info.File_Name.all) then - if Hostparm.OpenVMS then - Error_Msg - (Info.File_Name.all - & " already exists, use /OVERWRITE to overwrite"); - else - Error_Msg (Info.File_Name.all - & " already exists, use -w to overwrite"); - end if; - + Error_Msg (Info.File_Name.all + & " already exists, use -w to overwrite"); Exists := True; end if; end; @@ -1018,15 +1007,7 @@ procedure Gnatchop is Free (Buffer); end if; - -- Things aren't 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 then - Success := Read_Ptr <= Length + 1; - else - Success := Read_Ptr = Length + 1; - end if; + Success := Read_Ptr = Length + 1; end Read_File; ---------------------------- @@ -1083,12 +1064,7 @@ procedure Gnatchop is end loop; if Duplicates and not Overwrite_Files then - if Hostparm.OpenVMS then - Put_Line - ("use /OVERWRITE to overwrite files and keep last version"); - else - Put_Line ("use -w to overwrite files and keep last version"); - end if; + Put_Line ("use -w to overwrite files and keep last version"); end if; return Duplicates; @@ -1136,23 +1112,13 @@ procedure Gnatchop is if Param.all /= "" then for J in Param'Range loop if Param (J) not in '0' .. '9' then - if Hostparm.OpenVMS then - Error_Msg ("/FILE_NAME_MAX_LENGTH=nnn" & - " requires numeric parameter"); - else - Error_Msg ("-k# requires numeric parameter"); - end if; - + Error_Msg ("-k# requires numeric parameter"); return False; end if; end loop; else - if Hostparm.OpenVMS then - Param := new String'("39"); - else - Param := new String'("8"); - end if; + Param := new String'("8"); end if; Gnat_Args := @@ -1273,13 +1239,7 @@ procedure Gnatchop is return False; when Invalid_Parameter => - if Hostparm.OpenVMS then - Error_Msg ("/FILE_NAME_MAX_LENGTH=nnn qualifier" & - " requires numeric parameter"); - else - Error_Msg ("-k switch requires numeric parameter"); - end if; - + Error_Msg ("-k switch requires numeric parameter"); return False; end Scan_Arguments; @@ -1770,33 +1730,30 @@ procedure Gnatchop is begin -- Add the directory where gnatchop is invoked in front of the path, if - -- gnatchop is invoked with directory information. Only do this if the - -- platform is not VMS, where the notion of path does not really exist. + -- gnatchop is invoked with directory information. - if not Hostparm.OpenVMS then - declare - Command : constant String := Command_Name; + declare + Command : constant String := Command_Name; - begin - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - PATH : constant String := - Absolute_Dir - & Path_Separator - & Getenv ("PATH").all; - begin - Setenv ("PATH", PATH); - end; + begin + for Index in reverse Command'Range loop + if Command (Index) = Directory_Separator then + declare + Absolute_Dir : constant String := + Normalize_Pathname + (Command (Command'First .. Index)); + PATH : constant String := + Absolute_Dir + & Path_Separator + & Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; - exit; - end if; - end loop; - end; - end if; + exit; + end if; + end loop; + end; -- Process command line options and initialize global variables diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 7eb39ce..9cca2d8 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -26,7 +26,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; with Csets; -with Hostparm; use Hostparm; with Makeutl; use Makeutl; with MLib.Tgt; use MLib.Tgt; with MLib.Utl; @@ -66,8 +65,8 @@ procedure GNATCmd is Current_Verbosity : Prj.Verbosity := Prj.Default; Tool_Package_Name : Name_Id := No_Name; - B_Start : String_Ptr := new String'("b~"); - -- Prefix of binder generated file, changed to b__ for VMS + B_Start : constant String := "b~"; + -- Prefix of binder generated file, changed to b__ for gprbuild Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data (Is_Root_Tree => True); @@ -192,8 +191,7 @@ procedure GNATCmd is -- The index of the command in the arguments of the GNAT driver My_Exit_Status : Exit_Status := Success; - -- The exit status of the spawned tool. Used to set the correct VMS - -- exit status. + -- The exit status of the spawned tool. Current_Work_Dir : constant String := Get_Current_Dir; -- The path of the working directory @@ -203,9 +201,6 @@ procedure GNATCmd is -- indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric) -- should be invoked for all sources of all projects. - Max_OpenVMS_Logical_Length : constant Integer := 255; - -- The maximum length of OpenVMS logicals - ----------------------- -- Local Subprograms -- ----------------------- @@ -452,7 +447,7 @@ procedure GNATCmd is Add_To_Response_File (Get_Name_String (Proj.Project.Object_Directory.Name) & - B_Start.all & + B_Start & MLib.Fil.Ext_To (Get_Name_String (Project_Tree.Shared.String_Elements.Table @@ -465,7 +460,6 @@ procedure GNATCmd is -- such files. if not Is_Regular_File (Name_Buffer (1 .. Name_Len)) - and then B_Start.all /= "b__" then Add_To_Response_File (Get_Name_String @@ -491,7 +485,7 @@ procedure GNATCmd is Add_To_Response_File (Get_Name_String (Proj.Project.Object_Directory.Name) & - B_Start.all & + B_Start & Get_Name_String (Proj.Project.Library_Name) & ".ci"); @@ -501,7 +495,6 @@ procedure GNATCmd is -- such files. if not Is_Regular_File (Name_Buffer (1 .. Name_Len)) - and then B_Start.all /= "b__" then Add_To_Response_File (Get_Name_String @@ -1429,179 +1422,154 @@ begin Add_Str_To_Name_Buffer (Argument (J)); end loop; - -- On OpenVMS, setenv creates a logical whose length is limited to - -- 255 bytes. - - if OpenVMS and then Name_Len > Max_OpenVMS_Logical_Length then - Name_Buffer (Max_OpenVMS_Logical_Length - 2 - .. Max_OpenVMS_Logical_Length) := "..."; - Name_Len := Max_OpenVMS_Logical_Length; - end if; - Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len)); -- Add the directory where the GNAT driver is invoked in front of the path, - -- if the GNAT driver is invoked with directory information. Do not do this - -- for VMS, where the notion of path does not really exist. + -- if the GNAT driver is invoked with directory information. - if not OpenVMS then - declare - Command : constant String := Command_Name; - - begin - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - - PATH : constant String := - Absolute_Dir & Path_Separator & Getenv ("PATH").all; + declare + Command : constant String := Command_Name; + begin + for Index in reverse Command'Range loop + if Command (Index) = Directory_Separator then + declare + Absolute_Dir : constant String := + Normalize_Pathname + (Command (Command'First .. Index)); - begin - Setenv ("PATH", PATH); - end; + PATH : constant String := + Absolute_Dir & Path_Separator & Getenv ("PATH").all; - exit; - end if; - end loop; - end; - end if; + begin + Setenv ("PATH", PATH); + end; - -- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers, - -- filenames and pathnames to Unix style. + exit; + end if; + end loop; + end; - if Hostparm.OpenVMS - or else To_Lower (Getenv ("EMULATE_VMS").all) = "true" - then - VMS_Conversion (The_Command); + -- Scan the command line - B_Start := new String'("b__"); + -- First, scan to detect --version and/or --help - -- If not on VMS, scan the command line directly + Check_Version_And_Help ("GNAT", "1996"); - else - -- First, scan to detect --version and/or --help + begin + loop + if Command_Arg <= Argument_Count + and then Argument (Command_Arg) = "-v" + then + Verbose_Mode := True; + Command_Arg := Command_Arg + 1; - Check_Version_And_Help ("GNAT", "1996"); + elsif Command_Arg <= Argument_Count + and then Argument (Command_Arg) = "-dn" + then + Keep_Temporary_Files := True; + Command_Arg := Command_Arg + 1; - begin - loop - if Command_Arg <= Argument_Count - and then Argument (Command_Arg) = "-v" - then - Verbose_Mode := True; - Command_Arg := Command_Arg + 1; + else + exit; + end if; + end loop; - elsif Command_Arg <= Argument_Count - and then Argument (Command_Arg) = "-dn" - then - Keep_Temporary_Files := True; - Command_Arg := Command_Arg + 1; + -- If there is no command, just output the usage - else - exit; - end if; - end loop; + if Command_Arg > Argument_Count then + Non_VMS_Usage; + return; + end if; - -- If there is no command, just output the usage + The_Command := Real_Command_Type'Value (Argument (Command_Arg)); - if Command_Arg > Argument_Count then - Non_VMS_Usage; - return; - end if; + if Command_List (The_Command).VMS_Only then + Non_VMS_Usage; + Fail + ("command """ + & Command_List (The_Command).Cname.all + & """ can only be used on VMS"); + end if; - The_Command := Real_Command_Type'Value (Argument (Command_Arg)); + exception + when Constraint_Error => - if Command_List (The_Command).VMS_Only then - Non_VMS_Usage; - Fail - ("command """ - & Command_List (The_Command).Cname.all - & """ can only be used on VMS"); - end if; + -- Check if it is an alternate command - exception - when Constraint_Error => + declare + Alternate : Alternate_Command; - -- Check if it is an alternate command + begin + Alternate := Alternate_Command'Value + (Argument (Command_Arg)); + The_Command := Corresponding_To (Alternate); - declare - Alternate : Alternate_Command; + exception + when Constraint_Error => + Non_VMS_Usage; + Fail ("unknown command: " & Argument (Command_Arg)); + end; + end; - begin - Alternate := Alternate_Command'Value - (Argument (Command_Arg)); - The_Command := Corresponding_To (Alternate); - - exception - when Constraint_Error => - Non_VMS_Usage; - Fail ("unknown command: " & Argument (Command_Arg)); - end; - end; + -- Get the arguments from the command line and from the eventual + -- argument file(s) specified on the command line. - -- Get the arguments from the command line and from the eventual - -- argument file(s) specified on the command line. + for Arg in Command_Arg + 1 .. Argument_Count loop + declare + The_Arg : constant String := Argument (Arg); - for Arg in Command_Arg + 1 .. Argument_Count loop - declare - The_Arg : constant String := Argument (Arg); + begin + -- Check if an argument file is specified - begin - -- Check if an argument file is specified + if The_Arg (The_Arg'First) = '@' then + declare + Arg_File : Ada.Text_IO.File_Type; + Line : String (1 .. 256); + Last : Natural; - if The_Arg (The_Arg'First) = '@' then - declare - Arg_File : Ada.Text_IO.File_Type; - Line : String (1 .. 256); - Last : Natural; + begin + -- Open the file and fail if the file cannot be found begin - -- Open the file and fail if the file cannot be found - - begin - Open - (Arg_File, In_File, - The_Arg (The_Arg'First + 1 .. The_Arg'Last)); - - exception - when others => - Put (Standard_Error, "Cannot open argument file """); - Put (Standard_Error, - The_Arg (The_Arg'First + 1 .. The_Arg'Last)); - Put_Line (Standard_Error, """"); - raise Error_Exit; - end; + Open + (Arg_File, In_File, + The_Arg (The_Arg'First + 1 .. The_Arg'Last)); + + exception + when others => + Put (Standard_Error, "Cannot open argument file """); + Put (Standard_Error, + The_Arg (The_Arg'First + 1 .. The_Arg'Last)); + Put_Line (Standard_Error, """"); + raise Error_Exit; + end; - -- Read line by line and put the content of each non- - -- empty line in the Last_Switches table. + -- Read line by line and put the content of each non- + -- empty line in the Last_Switches table. - while not End_Of_File (Arg_File) loop - Get_Line (Arg_File, Line, Last); + while not End_Of_File (Arg_File) loop + Get_Line (Arg_File, Line, Last); - if Last /= 0 then - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := - new String'(Line (1 .. Last)); - end if; - end loop; + if Last /= 0 then + Last_Switches.Increment_Last; + Last_Switches.Table (Last_Switches.Last) := + new String'(Line (1 .. Last)); + end if; + end loop; - Close (Arg_File); - end; + Close (Arg_File); + end; - else - -- It is not an argument file; just put the argument in - -- the Last_Switches table. + else + -- It is not an argument file; just put the argument in + -- the Last_Switches table. - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := - new String'(The_Arg); - end if; - end; - end loop; - end if; + Last_Switches.Increment_Last; + Last_Switches.Table (Last_Switches.Last) := + new String'(The_Arg); + end if; + end; + end loop; declare Program : String_Access; @@ -2618,20 +2586,6 @@ begin if ASIS_Main /= null then Get_Closure; - -- On VMS, set up the env var again for source dirs file. This is - -- because the call to gnatmake has set this env var to another - -- file that has now been deleted. - - if Hostparm.OpenVMS then - - -- First make sure that the recorded file names are empty - - Prj.Env.Initialize (Project_Tree); - - Prj.Env.Set_Ada_Paths - (Project, Project_Tree, Including_Libraries => False); - end if; - -- For gnat check, gnat sync, gnat pretty, gnat metric, gnat list, -- and gnat stack, if no file has been put on the command line, call -- tool with all the sources of the main project. @@ -2726,14 +2680,5 @@ exception Delete_Temp_Config_Files; end if; - -- Since GNATCmd is normally called from DCL (the VMS shell), it must - -- return an understandable VMS exit status. However the exit status - -- returned *to* GNATCmd is a Posix style code, so we test it and return - -- just a simple success or failure on VMS. - - if Hostparm.OpenVMS and then My_Exit_Status /= Success then - Set_Exit_Status (Failure); - else - Set_Exit_Status (My_Exit_Status); - end if; + Set_Exit_Status (My_Exit_Status); end GNATCmd; diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 2fd05d9..c270e60 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -191,9 +191,9 @@ procedure Gnatls is -- Returns the capitalized image of Restriction function Normalize (Path : String) return String; - -- Returns a normalized path name, except on VMS where the argument Path - -- is returned, to keep the host pathname syntax. On Windows, the directory - -- separators are set to '\' in Normalize_Pathname. + -- Returns a normalized path name. + -- On Windows, the directory separators are set to '\' in + -- Normalize_Pathname. ------------------------------------------ -- GNATDIST specific output subprograms -- @@ -839,11 +839,7 @@ procedure Gnatls is function Normalize (Path : String) return String is begin - if OpenVMS_On_Target then - return Path; - else - return Normalize_Pathname (Path); - end if; + return Normalize_Pathname (Path); end Normalize; -------------------------------- @@ -1632,8 +1628,8 @@ begin Osint.Add_Default_Search_Dirs; - -- Get the target parameters to know if the target is OpenVMS, but only if - -- switch -nostdinc was not specified. + -- Get the target parameters, but only if switch -nostdinc was not + -- specified. Likely not strictly needed now that VMS is baselined??? if not Opt.No_Stdinc then Get_Target_Parameters; diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 47ed2e5..dd485a6 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -30,7 +30,6 @@ with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Dynamic_Tables; with GNAT.OS_Lib; use GNAT.OS_Lib; -with Hostparm; with Opt; with Osint; use Osint; with Output; use Output; @@ -549,35 +548,30 @@ procedure Gnatname is begin -- Add the directory where gnatname is invoked in front of the -- path, if gnatname is invoked with directory information. - -- Only do this if the platform is not VMS, where the notion of path - -- does not really exist. - if not Hostparm.OpenVMS then - declare - Command : constant String := Command_Name; - - begin - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; - - begin - Setenv ("PATH", PATH); - end; - - exit; - end if; - end loop; - end; - end if; + declare + Command : constant String := Command_Name; + begin + for Index in reverse Command'Range loop + if Command (Index) = Directory_Separator then + declare + Absolute_Dir : constant String := + Normalize_Pathname + (Command (Command'First .. Index)); + + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + + begin + Setenv ("PATH", PATH); + end; + + exit; + end if; + end loop; + end; -- Initialize tables diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index f2bbf05..b98f353 100644 --- a/gcc/ada/krunch.adb +++ b/gcc/ada/krunch.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- -- @@ -29,8 +29,6 @@ -- -- ------------------------------------------------------------------------------ -with Hostparm; - procedure Krunch (Buffer : in out String; Len : in out Natural; @@ -128,9 +126,7 @@ begin and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's') and then Len <= Maxlen then - -- When VMS is the host, it is always also the target - - if Hostparm.OpenVMS or else VMS_On_Target then + if VMS_On_Target then Len := Len + 1; Buffer (4 .. Len) := Buffer (3 .. Len - 1); Buffer (2) := '_'; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index a426df6..b71c28a 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2256,6 +2256,7 @@ package body Make is Is_Main_Source : Boolean; Args : Argument_List) is + pragma Unreferenced (Is_Main_Source); begin Arguments_Project := No_Project; Last_Argument := 0; @@ -2424,29 +2425,6 @@ package body Make is end; end if; - -- For VMS, when compiling the main source, add switch - -- -mdebug-main=_ada_ so that the executable can be debugged - -- by the standard VMS debugger. - - if not No_Main_Subprogram - and then Targparm.OpenVMS_On_Target - and then Is_Main_Source - then - -- First, check if compilation will be invoked with -g - - for J in 1 .. Last_Argument loop - if Arguments (J)'Length >= 2 - and then Arguments (J) (1 .. 2) = "-g" - and then (Arguments (J)'Length < 5 - or else Arguments (J) (1 .. 5) /= "-gnat") - then - Add_Arguments - ((1 => new String'("-mdebug-main=_ada_"))); - exit; - end if; - end loop; - end if; - -- Set Output_Is_Object, depending if there is a -S switch. -- If the bind step is not performed, and there is a -S switch, -- then we will not check for a valid object file. @@ -2650,8 +2628,8 @@ package body Make is -- 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. Until this problem is resolved, - -- we will ignore such processes. + -- processes that are received. ??? Revisit now that VMS is no + -- longer supported. loop Wait_Process (Pid, OK); @@ -4231,9 +4209,7 @@ package body Make is if Library_Projs.Table (Index).Extended_By = No_Project then - if Library_Projs.Table (Index).Library_Kind = Static - and then not Targparm.OpenVMS_On_Target - then + if Library_Projs.Table (Index).Library_Kind = Static then Linker_Switches.Increment_Last; Linker_Switches.Table (Linker_Switches.Last) := new String' @@ -5826,17 +5802,6 @@ package body Make is Osint.Add_Default_Search_Dirs; - -- Get the target parameters, so that the correct binder generated - -- files are generated if OpenVMS is the target. - - begin - Targparm.Get_Target_Parameters; - - exception - when Unrecoverable_Error => - Make_Failed ("*** make failed."); - end; - -- And bind and or link the library MLib.Prj.Build_Library @@ -6438,45 +6403,42 @@ package body Make is -- Add the directory where gnatmake is invoked in front of the path, -- if gnatmake is invoked from a bin directory or with directory - -- information. Only do this if the platform is not VMS, where the - -- notion of path does not really exist. + -- information. - if not OpenVMS then - declare - Prefix : constant String := Executable_Prefix_Path; - Command : constant String := Command_Name; + declare + Prefix : constant String := Executable_Prefix_Path; + Command : constant String := Command_Name; - begin - if Prefix'Length > 0 then - declare - PATH : constant String := - Prefix & Directory_Separator & "bin" & Path_Separator & - Getenv ("PATH").all; - begin - Setenv ("PATH", PATH); - end; + begin + if Prefix'Length > 0 then + declare + PATH : constant String := + Prefix & Directory_Separator & "bin" & Path_Separator & + Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; - else - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; - begin - Setenv ("PATH", PATH); - end; + else + for Index in reverse Command'Range loop + if Command (Index) = Directory_Separator then + declare + Absolute_Dir : constant String := + Normalize_Pathname + (Command (Command'First .. Index)); + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; - exit; - end if; - end loop; - end if; - end; - end if; + exit; + end if; + end loop; + end if; + end; -- Scan the switches and arguments diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index b192ef8..7d4b762 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -29,7 +29,6 @@ with Debug; with Err_Vars; use Err_Vars; with Errutil; with Fname; -with Hostparm; with Osint; use Osint; with Output; use Output; with Opt; use Opt; @@ -740,12 +739,6 @@ package body Makeutl is -- Beginning of Executable_Prefix_Path begin - -- For VMS, the path returned is always /gnu/ - - if Hostparm.OpenVMS then - return "/gnu/"; - end if; - -- First determine if a path prefix was placed in front of the -- executable name. diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb index 35ca8b2..869990d 100644 --- a/gcc/ada/memtrack.adb +++ b/gcc/ada/memtrack.adb @@ -60,7 +60,6 @@ -- GNU/Linux -- HP-UX -- Solaris --- Alpha OpenVMS -- NOTE FOR FUTURE PLATFORMS SUPPORT: It is assumed that type Duration is -- 64 bit. If the need arises to support architectures where this assumption diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 945f913..3686be3 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, AdaCore -- +-- Copyright (C) 2001-2014, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,7 +38,6 @@ with Sinput.P; with Snames; use Snames; with Switch; use Switch; with Table; -with Targparm; use Targparm; with Tempdir; with Types; use Types; @@ -61,8 +60,8 @@ package body MLib.Prj is ALI_Suffix : constant String := ".ali"; - B_Start : String_Ptr := new String'("b~"); - -- Prefix of bind file, changed to b__ for VMS + B_Start : constant String := "b~"; + -- Prefix of bind file S_Osinte_Ads : File_Name_Type := No_File; -- Name_Id for "s-osinte.ads" @@ -310,9 +309,6 @@ package body MLib.Prj is Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed; -- Set True if library needs to be linked with libgnarl - Libdecgnat_Needed : Boolean := False; - -- On OpenVMS, set True if library needs to be linked with libdecgnat - Object_Directory_Path : constant String := Get_Name_String (For_Project.Object_Directory.Display_Name); @@ -367,9 +363,7 @@ package body MLib.Prj is procedure Check_Libs (ALI_File : String; Main_Project : Boolean); -- Set Libgnarl_Needed if the ALI_File indicates that there is a need -- to link with -lgnarl (this is the case when there is a dependency - -- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file - -- indicates that there is a need to link with -ldecgnat (this is the - -- case when there is a dependency on dec.ads). + -- on s-osinte.ads). procedure Process (The_ALI : File_Name_Type); -- Check if the closure of a library unit which is or should be in the @@ -503,11 +497,7 @@ package body MLib.Prj is Id : ALI.ALI_Id; begin - if Libgnarl_Needed /= Yes - or else - (Main_Project - and then OpenVMS_On_Target) - then + if Libgnarl_Needed /= Yes then -- Scan the ALI file Name_Len := ALI_File'Length; @@ -536,11 +526,6 @@ package body MLib.Prj is else exit; end if; - - elsif OpenVMS_On_Target then - if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then - Libdecgnat_Needed := True; - end if; end if; end loop; end if; @@ -857,13 +842,8 @@ package body MLib.Prj is Arguments (1) := No_Main; Arguments (2) := Output_Switch; - if OpenVMS_On_Target then - B_Start := new String'("b__"); - end if; - Add_Argument - (B_Start.all - & Get_Name_String (For_Project.Library_Name) & ".adb"); + (B_Start & Get_Name_String (For_Project.Library_Name) & ".adb"); -- Make sure that the init procedure is never "adainit" @@ -1220,13 +1200,8 @@ package body MLib.Prj is Arguments (1) := Compile_Switch; Arguments (2) := No_Warning; - if OpenVMS_On_Target then - B_Start := new String'("b__"); - end if; - Add_Argument - (B_Start.all - & Get_Name_String (For_Project.Library_Name) & ".adb"); + (B_Start & Get_Name_String (For_Project.Library_Name) & ".adb"); -- If necessary, add the PIC option @@ -1429,7 +1404,7 @@ package body MLib.Prj is if In_Main_Object_Directory or else Last < 5 or else - C_Filename (1 .. B_Start'Length) /= B_Start.all + C_Filename (1 .. B_Start'Length) /= B_Start then Name_Len := 0; Add_Str_To_Name_Buffer (C_Filename); @@ -1458,7 +1433,7 @@ package body MLib.Prj is (Last >= 5 and then C_Filename (1 .. B_Start'Length) - = B_Start.all); + = B_Start); if Is_Regular_File (ALI_Path) then @@ -1624,21 +1599,6 @@ package body MLib.Prj is end if; end if; - if Libdecgnat_Needed then - Opts.Increment_Last; - - Opts.Table (Opts.Last) := - new String'("-L" & Lib_Directory & "/../declib"); - - Opts.Increment_Last; - - if The_Build_Mode = Static then - Opts.Table (Opts.Last) := new String'("-ldecgnat"); - else - Opts.Table (Opts.Last) := new String'(Shared_Lib ("decgnat")); - end if; - end if; - Opts.Increment_Last; if The_Build_Mode = Static then @@ -2131,10 +2091,6 @@ package body MLib.Prj is Object_Dir : Dir_Type; begin - if OpenVMS_On_Target then - B_Start := new String'("b__"); - end if; - -- If the library file does not exist, then the time stamp will -- be Empty_Time_Stamp, earlier than any other time stamp. @@ -2152,7 +2108,7 @@ package body MLib.Prj is -- generated file. if Is_Obj (Name_Buffer (1 .. Name_Len)) - and then Name_Buffer (1 .. B_Start'Length) /= B_Start.all + and then Name_Buffer (1 .. B_Start'Length) /= B_Start then -- Get the object file time stamp diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index 4c4d375..1c34efe 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2009, 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- -- @@ -27,7 +27,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; with Interfaces.C.Strings; with System; -with Hostparm; with Opt; with Output; use Output; @@ -459,12 +458,4 @@ package body MLib is return Separate_Paths; end Separate_Run_Path_Options; --- Package elaboration - -begin - -- Copy_Attributes always fails on VMS - - if Hostparm.OpenVMS then - Preserve := None; - end if; end MLib; diff --git a/gcc/ada/mlib.ads b/gcc/ada/mlib.ads index 0aa62d2..c8f3228 100644 --- a/gcc/ada/mlib.ads +++ b/gcc/ada/mlib.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2009, 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- -- @@ -91,7 +91,6 @@ package MLib is private Preserve : Attribute := Time_Stamps; - -- Used by Copy_ALI_Files. Changed to None for OpenVMS, because - -- Copy_Attributes always fails on VMS. + -- Used by Copy_ALI_Files. end MLib; diff --git a/gcc/ada/tempdir.adb b/gcc/ada/tempdir.adb index 7da1ef2..4936c26 100644 --- a/gcc/ada/tempdir.adb +++ b/gcc/ada/tempdir.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2013, 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- -- @@ -25,7 +25,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with Hostparm; use Hostparm; with Opt; use Opt; with Output; use Output; @@ -33,9 +32,8 @@ package body Tempdir is Tmpdir_Needs_To_Be_Displayed : Boolean := True; - Tmpdir : constant String := "TMPDIR"; - Gnutmpdir : constant String := "GNUTMPDIR"; - Temp_Dir : String_Access := new String'(""); + Tmpdir : constant String := "TMPDIR"; + Temp_Dir : String_Access := new String'(""); ---------------------- -- Create_Temp_File -- @@ -118,21 +116,7 @@ package body Tempdir is begin if Status then - - -- On VMS, if GNUTMPDIR is defined, use it - - if OpenVMS then - Dir := Getenv (Gnutmpdir); - - -- Otherwise, if GNUTMPDIR is not defined, try TMPDIR - - if Dir'Length = 0 then - Dir := Getenv (Tmpdir); - end if; - - else - Dir := Getenv (Tmpdir); - end if; + Dir := Getenv (Tmpdir); end if; Free (Temp_Dir); |