From patchwork Fri Aug 1 08:12:34 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 375582 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 879651400D7 for ; Fri, 1 Aug 2014 18:12:51 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:mime-version:content-type; q=dns; s= default; b=b1P7ngeVdXPmot/SCwKHlBlZIhObhbIcDMPelwrC3QOSmUO9atYnH JhOl/UFpYYzF3u5y8iRPovQou8Ub9jARd5mTRn0kMaAEQsGtjDd3hD44zMWBofFR kz8XOLyHbX2XDVTxEq3uPqdEBK/66pKusnI79xxKbeTsJC0gY9kDV4= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:mime-version:content-type; s= default; bh=CQ1ZxcVNsrkvO1X6cWpot52DFx8=; b=v90Z8HhSbTni+tY1HmyF pYjerPJplLFzADqePi0u7j42MXSW0SjQv7HEIU4z3SWgN2F71OwBDsZ7e2wqjB2/ 58t77Qs389ouBhPSBP5LqMy0KRWsiHqy1H3YZZWAV+9nxoyk9HkyZ+32mzpXxvNR kHq1SyU6aaVfcG2ONmBVh3E= Received: (qmail 19122 invoked by alias); 1 Aug 2014 08:12:42 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 19110 invoked by uid 89); 1 Aug 2014 08:12:40 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.1 required=5.0 tests=BAYES_00, T_FILL_THIS_FORM_SHORT, UNSUBSCRIBE_BODY, WEIRD_QUOTING autolearn=no version=3.3.2 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Fri, 01 Aug 2014 08:12:37 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0C97B116355 for ; Fri, 1 Aug 2014 04:12:35 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id VAcOkdiZfG+U for ; Fri, 1 Aug 2014 04:12:34 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [IPv6:2620:20:4000:0:a6ba:dbff:fe26:1f63]) by rock.gnat.com (Postfix) with ESMTP id E157E116321 for ; Fri, 1 Aug 2014 04:12:34 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id DFB843FE21; Fri, 1 Aug 2014 04:12:34 -0400 (EDT) Date: Fri, 1 Aug 2014 04:12:34 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Subject: [Ada] Remove VMS handling in most tools Message-ID: <20140801081234.GA22601@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15) Continuation of VMS removal in the GNAT front-end. Tested on x86_64-pc-linux-gnu, committed on trunk 2014-08-01 Arnaud Charlet * 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. Index: binde.adb =================================================================== --- binde.adb (revision 213263) +++ binde.adb (working copy) @@ -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 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 @@ 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; Index: bindgen.adb =================================================================== --- bindgen.adb (revision 213329) +++ bindgen.adb (working copy) @@ -52,10 +52,6 @@ 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 @@ -- 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 @@ """__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 @@ 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 @@ 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 @@ 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 Index: butil.adb =================================================================== --- butil.adb (revision 213263) +++ butil.adb (working copy) @@ -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 @@ 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; ------------------------ Index: clean.adb =================================================================== --- clean.adb (revision 213285) +++ clean.adb (working copy) @@ -64,15 +64,12 @@ 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,28 +1263,8 @@ 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 + Delete_File (Full_Name (1 .. Last), Success); - 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; - -- Here if no deletion required else @@ -1327,7 +1304,7 @@ -- 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 @@ 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 Index: gnatbind.adb =================================================================== --- gnatbind.adb (revision 213263) +++ gnatbind.adb (working copy) @@ -77,8 +77,6 @@ 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 @@ 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 @@ 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 Index: gnatchop.adb =================================================================== --- gnatchop.adb (revision 213263) +++ gnatchop.adb (working copy) @@ -36,7 +36,6 @@ with GNAT.Heap_Sort_G; with GNAT.Table; -with Hostparm; with Switch; use Switch; with Types; @@ -273,10 +272,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 Index: gnatcmd.adb =================================================================== --- gnatcmd.adb (revision 213263) +++ gnatcmd.adb (working copy) @@ -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 @@ 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 @@ -- 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 @@ -- 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 @@ 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 @@ -- 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 @@ 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 @@ -- 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,180 +1422,155 @@ 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; + 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 - 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; - PATH : constant String := - Absolute_Dir & Path_Separator & Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; - begin - Setenv ("PATH", PATH); - end; + exit; + end if; + end loop; + end; - exit; - end if; - end loop; - end; - end if; + -- Scan the command line - -- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers, - -- filenames and pathnames to Unix style. + -- First, scan to detect --version and/or --help - if Hostparm.OpenVMS - or else To_Lower (Getenv ("EMULATE_VMS").all) = "true" - then - VMS_Conversion (The_Command); + Check_Version_And_Help ("GNAT", "1996"); - B_Start := new String'("b__"); + begin + loop + if Command_Arg <= Argument_Count + and then Argument (Command_Arg) = "-v" + then + Verbose_Mode := True; + Command_Arg := Command_Arg + 1; - -- If not on VMS, scan the command line directly + elsif Command_Arg <= Argument_Count + and then Argument (Command_Arg) = "-dn" + then + Keep_Temporary_Files := True; + Command_Arg := Command_Arg + 1; - else - -- First, scan to detect --version and/or --help + else + exit; + end if; + end loop; - Check_Version_And_Help ("GNAT", "1996"); + -- If there is no command, just output the usage - begin - loop - if Command_Arg <= Argument_Count - and then Argument (Command_Arg) = "-v" - then - Verbose_Mode := True; - Command_Arg := Command_Arg + 1; + if Command_Arg > Argument_Count then + Non_VMS_Usage; + return; + end if; - elsif Command_Arg <= Argument_Count - and then Argument (Command_Arg) = "-dn" - then - Keep_Temporary_Files := True; - Command_Arg := Command_Arg + 1; + The_Command := Real_Command_Type'Value (Argument (Command_Arg)); - else - exit; - end if; - end loop; + 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; - -- If there is no command, just output the usage + exception + when Constraint_Error => - if Command_Arg > Argument_Count then - Non_VMS_Usage; - return; - end if; + -- Check if it is an alternate command - The_Command := Real_Command_Type'Value (Argument (Command_Arg)); + declare + Alternate : Alternate_Command; - 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; + begin + Alternate := Alternate_Command'Value + (Argument (Command_Arg)); + The_Command := Corresponding_To (Alternate); - exception - when Constraint_Error => + exception + when Constraint_Error => + Non_VMS_Usage; + Fail ("unknown command: " & Argument (Command_Arg)); + end; + end; - -- Check if it is an alternate command + -- 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); + + begin + -- Check if an argument file is specified + + if The_Arg (The_Arg'First) = '@' then declare - Alternate : Alternate_Command; + Arg_File : Ada.Text_IO.File_Type; + Line : String (1 .. 256); + Last : Natural; begin - Alternate := Alternate_Command'Value - (Argument (Command_Arg)); - The_Command := Corresponding_To (Alternate); + -- Open the file and fail if the file cannot be found - 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. - - for Arg in Command_Arg + 1 .. Argument_Count loop - declare - The_Arg : constant String := Argument (Arg); - - 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; - begin - -- Open the file and fail if the file cannot be found + Open + (Arg_File, In_File, + The_Arg (The_Arg'First + 1 .. The_Arg'Last)); - 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; - 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; - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := - new String'(The_Arg); - end if; - end; - end loop; - end if; - declare Program : String_Access; Exec_Path : String_Access; @@ -2618,20 +2586,6 @@ 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 @@ 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; Index: gnatls.adb =================================================================== --- gnatls.adb (revision 213263) +++ gnatls.adb (working copy) @@ -191,9 +191,9 @@ -- 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 @@ 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 @@ 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; Index: gnatname.adb =================================================================== --- gnatname.adb (revision 213263) +++ gnatname.adb (working copy) @@ -30,7 +30,6 @@ 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,36 +548,31 @@ 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; + 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 - 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; - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; - begin - Setenv ("PATH", PATH); - end; + exit; + end if; + end loop; + end; - exit; - end if; - end loop; - end; - end if; - -- Initialize tables Arguments.Set_Last (0); Index: krunch.adb =================================================================== --- krunch.adb (revision 213263) +++ krunch.adb (working copy) @@ -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 @@ 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) := '_'; Index: make.adb =================================================================== --- make.adb (revision 213263) +++ make.adb (working copy) @@ -2256,6 +2256,7 @@ 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 @@ 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 @@ -- 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 @@ 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 @@ 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 @@ -- 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 Index: makeutl.adb =================================================================== --- makeutl.adb (revision 213298) +++ makeutl.adb (working copy) @@ -29,7 +29,6 @@ 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 @@ -- 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. Index: memtrack.adb =================================================================== --- memtrack.adb (revision 213337) +++ memtrack.adb (working copy) @@ -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 Index: mlib-prj.adb =================================================================== --- mlib-prj.adb (revision 213263) +++ mlib-prj.adb (working copy) @@ -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 Snames; use Snames; with Switch; use Switch; with Table; -with Targparm; use Targparm; with Tempdir; with Types; use Types; @@ -61,8 +60,8 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ (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 @@ 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 @@ 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 @@ -- 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 Index: mlib.adb =================================================================== --- mlib.adb (revision 213263) +++ mlib.adb (working copy) @@ -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 Interfaces.C.Strings; with System; -with Hostparm; with Opt; with Output; use Output; @@ -459,12 +458,4 @@ 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; Index: mlib.ads =================================================================== --- mlib.ads (revision 213263) +++ mlib.ads (working copy) @@ -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 @@ 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; Index: tempdir.adb =================================================================== --- tempdir.adb (revision 213263) +++ tempdir.adb (working copy) @@ -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 @@ 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 @@ 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);