FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

binde.adb, [...]: Remove VMS handling.

Browse source 
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
This commit is contained in:
Arnaud Charlet 2014-08-01 08:12:27 +00:00 • committed by Arnaud Charlet
parent 148c744a17
commit 62883e6b17
18 changed files with 263 additions and 641 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/ada/ChangeLog
View file

@ -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.

10
gcc/ada/binde.adb
View file

@ -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;

94
gcc/ada/bindgen.adb
View file

@ -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

14
gcc/ada/butil.adb
View file

@ -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;
------------------------

44
gcc/ada/clean.adb
View file

@ -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

19
gcc/ada/gnatbind.adb
View file

@ -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

101
gcc/ada/gnatchop.adb
View file

@ -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

323
gcc/ada/gnatcmd.adb
View file

@ -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 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;
begin
Setenv ("PATH", PATH);
end;
exit;
end if;
end loop;
end;
end if;
-- If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
-- filenames and pathnames to Unix style.
if Hostparm.OpenVMS
or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
then
VMS_Conversion (The_Command);
B_Start := new String'("b__");
-- If not on VMS, scan the command line directly
else
-- First, scan to detect --version and/or --help
Check_Version_And_Help ("GNAT", "1996");
begin
loop
if Command_Arg <= Argument_Count
and then Argument (Command_Arg) = "-v"
then
Verbose_Mode := True;
Command_Arg := Command_Arg + 1;
elsif Command_Arg <= Argument_Count
and then Argument (Command_Arg) = "-dn"
then
Keep_Temporary_Files := True;
Command_Arg := Command_Arg + 1;
else
exit;
end if;
end loop;
-- If there is no command, just output the usage
if Command_Arg > Argument_Count then
Non_VMS_Usage;
return;
end if;
The_Command := Real_Command_Type'Value (Argument (Command_Arg));
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;
exception
when Constraint_Error =>
-- Check if it is an alternate command
-- if the GNAT driver is invoked with directory information.
declare
Command : constant String := Command_Name;
begin
for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then
declare
Alternate : Alternate_Command;
Absolute_Dir : constant String :=
Normalize_Pathname
(Command (Command'First .. Index));
PATH : constant String :=
Absolute_Dir & Path_Separator & Getenv ("PATH").all;
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));
Setenv ("PATH", PATH);
end;
end;
-- Get the arguments from the command line and from the eventual
-- argument file(s) specified on the command line.
exit;
end if;
end loop;
end;
-- Scan the command line
-- First, scan to detect --version and/or --help
Check_Version_And_Help ("GNAT", "1996");
begin
loop
if Command_Arg <= Argument_Count
and then Argument (Command_Arg) = "-v"
then
Verbose_Mode := True;
Command_Arg := Command_Arg + 1;
elsif Command_Arg <= Argument_Count
and then Argument (Command_Arg) = "-dn"
then
Keep_Temporary_Files := True;
Command_Arg := Command_Arg + 1;
else
exit;
end if;
end loop;
-- If there is no command, just output the usage
if Command_Arg > Argument_Count then
Non_VMS_Usage;
return;
end if;
The_Command := Real_Command_Type'Value (Argument (Command_Arg));
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;
exception
when Constraint_Error =>
-- Check if it is an alternate command
for Arg in Command_Arg + 1 .. Argument_Count loop
declare
The_Arg : constant String := Argument (Arg);
Alternate : Alternate_Command;
begin
-- Check if an argument file is specified
Alternate := Alternate_Command'Value
(Argument (Command_Arg));
The_Command := Corresponding_To (Alternate);
if The_Arg (The_Arg'First) = '@' then
declare
Arg_File : Ada.Text_IO.File_Type;
Line : String (1 .. 256);
Last : Natural;
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
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;
-- 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);
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);
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;
else
-- It is not an argument file; just put the argument in
-- the Last_Switches table.
-- Read line by line and put the content of each non-
-- empty line 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;
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;
Close (Arg_File);
end;
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;
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;

16
gcc/ada/gnatls.adb
View file

@ -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;

46
gcc/ada/gnatname.adb
View file

@ -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;
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;
end if;
exit;
end if;
end loop;
end;
-- Initialize tables

8
gcc/ada/krunch.adb
View file

@ -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) := '_';

110
gcc/ada/make.adb
View file

@ -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

7
gcc/ada/makeutl.adb
View file

@ -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.

1
gcc/ada/memtrack.adb
View file

@ -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

64
gcc/ada/mlib-prj.adb
View file

@ -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

11
gcc/ada/mlib.adb
View file

@ -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;

5
gcc/ada/mlib.ads
View file

@ -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;

24
gcc/ada/tempdir.adb
View file

@ -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);