Skip to content

R
riscv-gcc-1
Commit 62883e6b by Arnaud Charlet Committed by Arnaud Charlet
Options

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
parent 148c744a
Showing with 132 additions and 455 deletions
gcc/ada/ChangeLog
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> 2014-08-01 Pascal Obry <obry@adacore.com>
* adaint.h, adaint.c (__gnat_file_length): Returns an __int64. * adaint.h, adaint.c (__gnat_file_length): Returns an __int64.
......
gcc/ada/binde.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -31,7 +31,6 @@ with Namet; use Namet; ...@@ -31,7 +31,6 @@ with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Osint; with Osint;
with Output; use Output; with Output; use Output;
with Targparm; use Targparm;
with System.Case_Util; use System.Case_Util; with System.Case_Util; use System.Case_Util;
...@@ -1089,12 +1088,7 @@ package body Binde is ...@@ -1089,12 +1088,7 @@ package body Binde is
if Pessimistic_Elab_Order if Pessimistic_Elab_Order
and not Dynamic_Elaboration_Checks_Specified and not Dynamic_Elaboration_Checks_Specified
then then
if OpenVMS_On_Target then Error_Msg ("?use of -p switch questionable");
Error_Msg ("?use of /PESSIMISTIC_ELABORATION questionable");
else
Error_Msg ("?use of -p switch questionable");
end if;
Error_Msg ("?since all units compiled with static elaboration model"); Error_Msg ("?since all units compiled with static elaboration model");
end if; end if;
......
gcc/ada/bindgen.adb
...@@ -52,10 +52,6 @@ package body Bindgen is ...@@ -52,10 +52,6 @@ package body Bindgen is
Last : Natural := 0; Last : Natural := 0;
-- Last location in Statement_Buffer currently set -- 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; With_GNARL : Boolean := False;
-- Flag which indicates whether the program uses the GNARL library -- Flag which indicates whether the program uses the GNARL library
-- (presence of the unit System.OS_Interface) -- (presence of the unit System.OS_Interface)
...@@ -325,9 +321,7 @@ package body Bindgen is ...@@ -325,9 +321,7 @@ package body Bindgen is
-- Move routine for sorting linker options -- Move routine for sorting linker options
procedure Resolve_Binder_Options; procedure Resolve_Binder_Options;
-- Set the value of With_GNARL and With_DECGNAT. The latter only on VMS -- Set the value of With_GNARL.
-- since it tests for a package named "dec" which might cause a conflict
-- on non-VMS systems.
procedure Set_Char (C : Character); procedure Set_Char (C : Character);
-- Set given character in Statement_Buffer at the Last + 1 position -- Set given character in Statement_Buffer at the Last + 1 position
...@@ -659,36 +653,6 @@ package body Bindgen is ...@@ -659,36 +653,6 @@ package body Bindgen is
"""__gnat_finalize_library_objects"");"); """__gnat_finalize_library_objects"");");
end if; 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 -- Initialize stack limit variable of the environment task if the
-- stack check method is stack limit and stack check is enabled. -- stack check method is stack limit and stack check is enabled.
...@@ -886,44 +850,6 @@ package body Bindgen is ...@@ -886,44 +850,6 @@ package body Bindgen is
WBI (" Install_Handler;"); WBI (" Install_Handler;");
WBI (" end if;"); WBI (" end if;");
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; end if;
-- Generate call to set Initialize_Scalar values if active -- Generate call to set Initialize_Scalar values if active
...@@ -2138,18 +2064,6 @@ package body Bindgen is ...@@ -2138,18 +2064,6 @@ package body Bindgen is
WBI (" -- " & Name_Buffer (1 .. Name_Len)); 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 if With_GNARL then
Name_Len := 0; Name_Len := 0;
...@@ -3025,12 +2939,6 @@ package body Bindgen is ...@@ -3025,12 +2939,6 @@ package body Bindgen is
Check_Package (With_GNARL, "system.os_interface%s"); 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 -- Ditto for the use of restricted tasking
Check_Package Check_Package
......
gcc/ada/butil.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -23,8 +23,7 @@ ...@@ -23,8 +23,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Output; use Output; with Output; use Output;
with Targparm; use Targparm;
package body Butil is package body Butil is
...@@ -41,14 +40,7 @@ package body Butil is ...@@ -41,14 +40,7 @@ package body Butil is
or else (Name_Len > 4 or else (Name_Len > 4
and then (Name_Buffer (1 .. 5) = "gnat%" and then (Name_Buffer (1 .. 5) = "gnat%"
or else or else
Name_Buffer (1 .. 5) = "gnat.")) 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."));
end Is_Internal_Unit; end Is_Internal_Unit;
------------------------ ------------------------
......
gcc/ada/clean.adb
...@@ -64,15 +64,12 @@ package body Clean is ...@@ -64,15 +64,12 @@ package body Clean is
ALI_Suffix : constant String := ".ali"; ALI_Suffix : constant String := ".ali";
Tree_Suffix : constant String := ".adt"; Tree_Suffix : constant String := ".adt";
Object_Suffix : constant String := Get_Target_Object_Suffix.all; Object_Suffix : constant String := Get_Target_Object_Suffix.all;
Debug_Suffix : String := ".dg"; Debug_Suffix : constant String := ".dg";
-- Changed to "_dg" for VMS in the body of the package Repinfo_Suffix : constant String := ".rep";
-- Suffix of representation info files.
Repinfo_Suffix : String := ".rep"; B_Start : constant String := "b~";
-- Changed to "_rep" for VMS in the body of the package
B_Start : String_Ptr := new String'("b~");
-- Prefix of binder generated file, and number of actual characters used. -- 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 := Project_Tree : constant Project_Tree_Ref :=
new Project_Tree_Data (Is_Root_Tree => True); new Project_Tree_Data (Is_Root_Tree => True);
...@@ -1266,27 +1263,7 @@ package body Clean is ...@@ -1266,27 +1263,7 @@ package body Clean is
or else Is_Writable_File (Full_Name (1 .. Last)) or else Is_Writable_File (Full_Name (1 .. Last))
or else Is_Symbolic_Link (Full_Name (1 .. Last)) or else Is_Symbolic_Link (Full_Name (1 .. Last))
then 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 -- Here if no deletion required
...@@ -1327,7 +1304,7 @@ package body Clean is ...@@ -1327,7 +1304,7 @@ package body Clean is
-- Build the file name (before the extension) -- 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; File_Name (B_Start'Length + 1 .. Last) := Source_Name;
-- Spec -- Spec
...@@ -1590,16 +1567,7 @@ package body Clean is ...@@ -1590,16 +1567,7 @@ package body Clean is
Prj.Tree.Initialize (Project_Node_Tree); Prj.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree); Prj.Initialize (Project_Tree);
-- Check if the platform is VMS and, if it is, change some variables
Targparm.Get_Target_Parameters; 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; end if;
-- Reset global variables -- Reset global variables
......
gcc/ada/gnatbind.adb
...@@ -77,8 +77,6 @@ procedure Gnatbind is ...@@ -77,8 +77,6 @@ procedure Gnatbind is
Output_File_Name_Seen : Boolean := False; Output_File_Name_Seen : Boolean := False;
Output_File_Name : String_Ptr := new String'(""); Output_File_Name : String_Ptr := new String'("");
L_Switch_Seen : Boolean := False;
Mapping_File : String_Ptr := null; Mapping_File : String_Ptr := null;
package Closure_Sources is new Table.Table package Closure_Sources is new Table.Table
...@@ -338,12 +336,6 @@ procedure Gnatbind is ...@@ -338,12 +336,6 @@ procedure Gnatbind is
elsif Argv (2) = 'L' then elsif Argv (2) = 'L' then
if Argv'Length >= 3 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.Bind_For_Library := True;
Opt.Ada_Init_Name := Opt.Ada_Init_Name :=
new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix); new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
...@@ -642,17 +634,6 @@ begin ...@@ -642,17 +634,6 @@ begin
Cumulative_Restrictions := Targparm.Restrictions_On_Target; 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 -- Acquire configurable run-time mode
if Configurable_Run_Time_On_Target then if Configurable_Run_Time_On_Target then
......
gcc/ada/gnatchop.adb
...@@ -36,7 +36,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; ...@@ -36,7 +36,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Heap_Sort_G; with GNAT.Heap_Sort_G;
with GNAT.Table; with GNAT.Table;
with Hostparm;
with Switch; use Switch; with Switch; use Switch;
with Types; with Types;
...@@ -273,10 +272,7 @@ procedure Gnatchop is ...@@ -273,10 +272,7 @@ procedure Gnatchop is
Success : out Boolean); Success : out Boolean);
-- Reads file associated with FS into the newly allocated -- Reads file associated with FS into the newly allocated
-- string Contents. -- string Contents.
-- [VMS] Success is true iff the number of bytes read is less than or -- Success is true iff the number of bytes read is equal to the file size.
-- equal to the file size.
-- [Other] Success is true iff the number of bytes read is equal to
-- the file size.
function Report_Duplicate_Units return Boolean; function Report_Duplicate_Units return Boolean;
-- Output messages about duplicate units in the input files in Unit.Table -- Output messages about duplicate units in the input files in Unit.Table
...@@ -387,15 +383,8 @@ procedure Gnatchop is ...@@ -387,15 +383,8 @@ procedure Gnatchop is
begin begin
if Is_Writable_File (Info.File_Name.all) then if Is_Writable_File (Info.File_Name.all) then
if Hostparm.OpenVMS then Error_Msg (Info.File_Name.all
Error_Msg & " already exists, use -w to overwrite");
(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;
Exists := True; Exists := True;
end if; end if;
end; end;
...@@ -1018,15 +1007,7 @@ procedure Gnatchop is ...@@ -1018,15 +1007,7 @@ procedure Gnatchop is
Free (Buffer); Free (Buffer);
end if; end if;
-- Things aren't simple on VMS due to the plethora of file types and Success := Read_Ptr = Length + 1;
-- 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;
end Read_File; end Read_File;
---------------------------- ----------------------------
...@@ -1083,12 +1064,7 @@ procedure Gnatchop is ...@@ -1083,12 +1064,7 @@ procedure Gnatchop is
end loop; end loop;
if Duplicates and not Overwrite_Files then if Duplicates and not Overwrite_Files then
if Hostparm.OpenVMS then Put_Line ("use -w to overwrite files and keep last version");
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;
end if; end if;
return Duplicates; return Duplicates;
...@@ -1136,23 +1112,13 @@ procedure Gnatchop is ...@@ -1136,23 +1112,13 @@ procedure Gnatchop is
if Param.all /= "" then if Param.all /= "" then
for J in Param'Range loop for J in Param'Range loop
if Param (J) not in '0' .. '9' then if Param (J) not in '0' .. '9' then
if Hostparm.OpenVMS then Error_Msg ("-k# requires numeric parameter");
Error_Msg ("/FILE_NAME_MAX_LENGTH=nnn" &
" requires numeric parameter");
else
Error_Msg ("-k# requires numeric parameter");
end if;
return False; return False;
end if; end if;
end loop; end loop;
else else
if Hostparm.OpenVMS then Param := new String'("8");
Param := new String'("39");
else
Param := new String'("8");
end if;
end if; end if;
Gnat_Args := Gnat_Args :=
...@@ -1273,13 +1239,7 @@ procedure Gnatchop is ...@@ -1273,13 +1239,7 @@ procedure Gnatchop is
return False; return False;
when Invalid_Parameter => when Invalid_Parameter =>
if Hostparm.OpenVMS then Error_Msg ("-k switch requires numeric parameter");
Error_Msg ("/FILE_NAME_MAX_LENGTH=nnn qualifier" &
" requires numeric parameter");
else
Error_Msg ("-k switch requires numeric parameter");
end if;
return False; return False;
end Scan_Arguments; end Scan_Arguments;
...@@ -1770,33 +1730,30 @@ procedure Gnatchop is ...@@ -1770,33 +1730,30 @@ procedure Gnatchop is
begin begin
-- Add the directory where gnatchop is invoked in front of the path, if -- Add the directory where gnatchop is invoked in front of the path, if
-- gnatchop is invoked with directory information. Only do this if the -- gnatchop is invoked with directory information.
-- platform is not VMS, where the notion of path does not really exist.
if not Hostparm.OpenVMS then declare
declare Command : constant String := Command_Name;
Command : constant String := Command_Name;
begin begin
for Index in reverse Command'Range loop for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then if Command (Index) = Directory_Separator then
declare declare
Absolute_Dir : constant String := Absolute_Dir : constant String :=
Normalize_Pathname Normalize_Pathname
(Command (Command'First .. Index)); (Command (Command'First .. Index));
PATH : constant String := PATH : constant String :=
Absolute_Dir Absolute_Dir
& Path_Separator & Path_Separator
& Getenv ("PATH").all; & Getenv ("PATH").all;
begin begin
Setenv ("PATH", PATH); Setenv ("PATH", PATH);
end; end;
exit; exit;
end if; end if;
end loop; end loop;
end; end;
end if;
-- Process command line options and initialize global variables -- Process command line options and initialize global variables
......
gcc/ada/gnatls.adb
...@@ -191,9 +191,9 @@ procedure Gnatls is ...@@ -191,9 +191,9 @@ procedure Gnatls is
-- Returns the capitalized image of Restriction -- Returns the capitalized image of Restriction
function Normalize (Path : String) return String; function Normalize (Path : String) return String;
-- Returns a normalized path name, except on VMS where the argument Path -- Returns a normalized path name.
-- is returned, to keep the host pathname syntax. On Windows, the directory -- On Windows, the directory separators are set to '\' in
-- separators are set to '\' in Normalize_Pathname. -- Normalize_Pathname.
------------------------------------------ ------------------------------------------
-- GNATDIST specific output subprograms -- -- GNATDIST specific output subprograms --
...@@ -839,11 +839,7 @@ procedure Gnatls is ...@@ -839,11 +839,7 @@ procedure Gnatls is
function Normalize (Path : String) return String is function Normalize (Path : String) return String is
begin begin
if OpenVMS_On_Target then return Normalize_Pathname (Path);
return Path;
else
return Normalize_Pathname (Path);
end if;
end Normalize; end Normalize;
-------------------------------- --------------------------------
...@@ -1632,8 +1628,8 @@ begin ...@@ -1632,8 +1628,8 @@ begin
Osint.Add_Default_Search_Dirs; Osint.Add_Default_Search_Dirs;
-- Get the target parameters to know if the target is OpenVMS, but only if -- Get the target parameters, but only if switch -nostdinc was not
-- switch -nostdinc was not specified. -- specified. Likely not strictly needed now that VMS is baselined???
if not Opt.No_Stdinc then if not Opt.No_Stdinc then
Get_Target_Parameters; Get_Target_Parameters;
......
gcc/ada/gnatname.adb
...@@ -30,7 +30,6 @@ with GNAT.Command_Line; use GNAT.Command_Line; ...@@ -30,7 +30,6 @@ with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.Dynamic_Tables; with GNAT.Dynamic_Tables;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
with Hostparm;
with Opt; with Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
...@@ -549,35 +548,30 @@ procedure Gnatname is ...@@ -549,35 +548,30 @@ procedure Gnatname is
begin begin
-- Add the directory where gnatname is invoked in front of the -- Add the directory where gnatname is invoked in front of the
-- path, if gnatname is invoked with directory information. -- 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
declare Command : constant String := Command_Name;
Command : constant String := Command_Name; begin
for Index in reverse Command'Range loop
begin if Command (Index) = Directory_Separator then
for Index in reverse Command'Range loop declare
if Command (Index) = Directory_Separator then Absolute_Dir : constant String :=
declare Normalize_Pathname
Absolute_Dir : constant String := (Command (Command'First .. Index));
Normalize_Pathname
(Command (Command'First .. Index)); PATH : constant String :=
Absolute_Dir &
PATH : constant String := Path_Separator &
Absolute_Dir & Getenv ("PATH").all;
Path_Separator &
Getenv ("PATH").all; begin
Setenv ("PATH", PATH);
begin end;
Setenv ("PATH", PATH);
end; exit;
end if;
exit; end loop;
end if; end;
end loop;
end;
end if;
-- Initialize tables -- Initialize tables
......
gcc/ada/krunch.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,8 +29,6 @@ ...@@ -29,8 +29,6 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Hostparm;
procedure Krunch procedure Krunch
(Buffer : in out String; (Buffer : in out String;
Len : in out Natural; Len : in out Natural;
...@@ -128,9 +126,7 @@ begin ...@@ -128,9 +126,7 @@ begin
and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's') and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
and then Len <= Maxlen and then Len <= Maxlen
then then
-- When VMS is the host, it is always also the target if VMS_On_Target then
if Hostparm.OpenVMS or else VMS_On_Target then
Len := Len + 1; Len := Len + 1;
Buffer (4 .. Len) := Buffer (3 .. Len - 1); Buffer (4 .. Len) := Buffer (3 .. Len - 1);
Buffer (2) := '_'; Buffer (2) := '_';
......
gcc/ada/make.adb
...@@ -2256,6 +2256,7 @@ package body Make is ...@@ -2256,6 +2256,7 @@ package body Make is
Is_Main_Source : Boolean; Is_Main_Source : Boolean;
Args : Argument_List) Args : Argument_List)
is is
pragma Unreferenced (Is_Main_Source);
begin begin
Arguments_Project := No_Project; Arguments_Project := No_Project;
Last_Argument := 0; Last_Argument := 0;
...@@ -2424,29 +2425,6 @@ package body Make is ...@@ -2424,29 +2425,6 @@ package body Make is
end; end;
end if; 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. -- Set Output_Is_Object, depending if there is a -S switch.
-- If the bind step is not performed, and 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. -- then we will not check for a valid object file.
...@@ -2650,8 +2628,8 @@ package body Make is ...@@ -2650,8 +2628,8 @@ package body Make is
-- The loop here is a work-around for a problem on VMS; in some -- The loop here is a work-around for a problem on VMS; in some
-- circumstances (shared library and several executables, for -- circumstances (shared library and several executables, for
-- example), there are child processes other than compilation -- example), there are child processes other than compilation
-- processes that are received. Until this problem is resolved, -- processes that are received. ??? Revisit now that VMS is no
-- we will ignore such processes. -- longer supported.
loop loop
Wait_Process (Pid, OK); Wait_Process (Pid, OK);
...@@ -4231,9 +4209,7 @@ package body Make is ...@@ -4231,9 +4209,7 @@ package body Make is
if if
Library_Projs.Table (Index).Extended_By = No_Project Library_Projs.Table (Index).Extended_By = No_Project
then then
if Library_Projs.Table (Index).Library_Kind = Static if Library_Projs.Table (Index).Library_Kind = Static then
and then not Targparm.OpenVMS_On_Target
then
Linker_Switches.Increment_Last; Linker_Switches.Increment_Last;
Linker_Switches.Table (Linker_Switches.Last) := Linker_Switches.Table (Linker_Switches.Last) :=
new String' new String'
...@@ -5826,17 +5802,6 @@ package body Make is ...@@ -5826,17 +5802,6 @@ package body Make is
Osint.Add_Default_Search_Dirs; 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 -- And bind and or link the library
MLib.Prj.Build_Library MLib.Prj.Build_Library
...@@ -6438,45 +6403,42 @@ package body Make is ...@@ -6438,45 +6403,42 @@ package body Make is
-- Add the directory where gnatmake is invoked in front of the path, -- Add the directory where gnatmake is invoked in front of the path,
-- if gnatmake is invoked from a bin directory or with directory -- if gnatmake is invoked from a bin directory or with directory
-- information. Only do this if the platform is not VMS, where the -- information.
-- notion of path does not really exist.
if not OpenVMS then declare
declare Prefix : constant String := Executable_Prefix_Path;
Prefix : constant String := Executable_Prefix_Path; Command : constant String := Command_Name;
Command : constant String := Command_Name;
begin begin
if Prefix'Length > 0 then if Prefix'Length > 0 then
declare declare
PATH : constant String := PATH : constant String :=
Prefix & Directory_Separator & "bin" & Path_Separator & Prefix & Directory_Separator & "bin" & Path_Separator &
Getenv ("PATH").all; Getenv ("PATH").all;
begin begin
Setenv ("PATH", PATH); Setenv ("PATH", PATH);
end; end;
else else
for Index in reverse Command'Range loop for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then if Command (Index) = Directory_Separator then
declare declare
Absolute_Dir : constant String := Absolute_Dir : constant String :=
Normalize_Pathname Normalize_Pathname
(Command (Command'First .. Index)); (Command (Command'First .. Index));
PATH : constant String := PATH : constant String :=
Absolute_Dir & Absolute_Dir &
Path_Separator & Path_Separator &
Getenv ("PATH").all; Getenv ("PATH").all;
begin begin
Setenv ("PATH", PATH); Setenv ("PATH", PATH);
end; end;
exit; exit;
end if; end if;
end loop; end loop;
end if; end if;
end; end;
end if;
-- Scan the switches and arguments -- Scan the switches and arguments
......
gcc/ada/makeutl.adb
...@@ -29,7 +29,6 @@ with Debug; ...@@ -29,7 +29,6 @@ with Debug;
with Err_Vars; use Err_Vars; with Err_Vars; use Err_Vars;
with Errutil; with Errutil;
with Fname; with Fname;
with Hostparm;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
with Opt; use Opt; with Opt; use Opt;
...@@ -740,12 +739,6 @@ package body Makeutl is ...@@ -740,12 +739,6 @@ package body Makeutl is
-- Beginning of Executable_Prefix_Path -- Beginning of Executable_Prefix_Path
begin 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 -- First determine if a path prefix was placed in front of the
-- executable name. -- executable name.
......
gcc/ada/memtrack.adb
...@@ -60,7 +60,6 @@ ...@@ -60,7 +60,6 @@
-- GNU/Linux -- GNU/Linux
-- HP-UX -- HP-UX
-- Solaris -- Solaris
-- Alpha OpenVMS
-- NOTE FOR FUTURE PLATFORMS SUPPORT: It is assumed that type Duration is -- 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 bit. If the need arises to support architectures where this assumption
......
gcc/ada/mlib-prj.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -38,7 +38,6 @@ with Sinput.P; ...@@ -38,7 +38,6 @@ with Sinput.P;
with Snames; use Snames; with Snames; use Snames;
with Switch; use Switch; with Switch; use Switch;
with Table; with Table;
with Targparm; use Targparm;
with Tempdir; with Tempdir;
with Types; use Types; with Types; use Types;
...@@ -61,8 +60,8 @@ package body MLib.Prj is ...@@ -61,8 +60,8 @@ package body MLib.Prj is
ALI_Suffix : constant String := ".ali"; ALI_Suffix : constant String := ".ali";
B_Start : String_Ptr := new String'("b~"); B_Start : constant String := "b~";
-- Prefix of bind file, changed to b__ for VMS -- Prefix of bind file
S_Osinte_Ads : File_Name_Type := No_File; S_Osinte_Ads : File_Name_Type := No_File;
-- Name_Id for "s-osinte.ads" -- Name_Id for "s-osinte.ads"
...@@ -310,9 +309,6 @@ package body MLib.Prj is ...@@ -310,9 +309,6 @@ package body MLib.Prj is
Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed; Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed;
-- Set True if library needs to be linked with libgnarl -- 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 := Object_Directory_Path : constant String :=
Get_Name_String Get_Name_String
(For_Project.Object_Directory.Display_Name); (For_Project.Object_Directory.Display_Name);
...@@ -367,9 +363,7 @@ package body MLib.Prj is ...@@ -367,9 +363,7 @@ package body MLib.Prj is
procedure Check_Libs (ALI_File : String; Main_Project : Boolean); procedure Check_Libs (ALI_File : String; Main_Project : Boolean);
-- Set Libgnarl_Needed if the ALI_File indicates that there is a need -- 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 -- 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 -- on s-osinte.ads).
-- indicates that there is a need to link with -ldecgnat (this is the
-- case when there is a dependency on dec.ads).
procedure Process (The_ALI : File_Name_Type); procedure Process (The_ALI : File_Name_Type);
-- Check if the closure of a library unit which is or should be in the -- Check if the closure of a library unit which is or should be in the
...@@ -503,11 +497,7 @@ package body MLib.Prj is ...@@ -503,11 +497,7 @@ package body MLib.Prj is
Id : ALI.ALI_Id; Id : ALI.ALI_Id;
begin begin
if Libgnarl_Needed /= Yes if Libgnarl_Needed /= Yes then
or else
(Main_Project
and then OpenVMS_On_Target)
then
-- Scan the ALI file -- Scan the ALI file
Name_Len := ALI_File'Length; Name_Len := ALI_File'Length;
...@@ -536,11 +526,6 @@ package body MLib.Prj is ...@@ -536,11 +526,6 @@ package body MLib.Prj is
else else
exit; exit;
end if; 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 if;
end loop; end loop;
end if; end if;
...@@ -857,13 +842,8 @@ package body MLib.Prj is ...@@ -857,13 +842,8 @@ package body MLib.Prj is
Arguments (1) := No_Main; Arguments (1) := No_Main;
Arguments (2) := Output_Switch; Arguments (2) := Output_Switch;
if OpenVMS_On_Target then
B_Start := new String'("b__");
end if;
Add_Argument Add_Argument
(B_Start.all (B_Start & Get_Name_String (For_Project.Library_Name) & ".adb");
& Get_Name_String (For_Project.Library_Name) & ".adb");
-- Make sure that the init procedure is never "adainit" -- Make sure that the init procedure is never "adainit"
...@@ -1220,13 +1200,8 @@ package body MLib.Prj is ...@@ -1220,13 +1200,8 @@ package body MLib.Prj is
Arguments (1) := Compile_Switch; Arguments (1) := Compile_Switch;
Arguments (2) := No_Warning; Arguments (2) := No_Warning;
if OpenVMS_On_Target then
B_Start := new String'("b__");
end if;
Add_Argument Add_Argument
(B_Start.all (B_Start & Get_Name_String (For_Project.Library_Name) & ".adb");
& Get_Name_String (For_Project.Library_Name) & ".adb");
-- If necessary, add the PIC option -- If necessary, add the PIC option
...@@ -1429,7 +1404,7 @@ package body MLib.Prj is ...@@ -1429,7 +1404,7 @@ package body MLib.Prj is
if In_Main_Object_Directory if In_Main_Object_Directory
or else Last < 5 or else Last < 5
or else or else
C_Filename (1 .. B_Start'Length) /= B_Start.all C_Filename (1 .. B_Start'Length) /= B_Start
then then
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (C_Filename); Add_Str_To_Name_Buffer (C_Filename);
...@@ -1458,7 +1433,7 @@ package body MLib.Prj is ...@@ -1458,7 +1433,7 @@ package body MLib.Prj is
(Last >= 5 (Last >= 5
and then and then
C_Filename (1 .. B_Start'Length) C_Filename (1 .. B_Start'Length)
= B_Start.all); = B_Start);
if Is_Regular_File (ALI_Path) then if Is_Regular_File (ALI_Path) then
...@@ -1624,21 +1599,6 @@ package body MLib.Prj is ...@@ -1624,21 +1599,6 @@ package body MLib.Prj is
end if; end if;
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; Opts.Increment_Last;
if The_Build_Mode = Static then if The_Build_Mode = Static then
...@@ -2131,10 +2091,6 @@ package body MLib.Prj is ...@@ -2131,10 +2091,6 @@ package body MLib.Prj is
Object_Dir : Dir_Type; Object_Dir : Dir_Type;
begin 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 -- If the library file does not exist, then the time stamp will
-- be Empty_Time_Stamp, earlier than any other time stamp. -- be Empty_Time_Stamp, earlier than any other time stamp.
...@@ -2152,7 +2108,7 @@ package body MLib.Prj is ...@@ -2152,7 +2108,7 @@ package body MLib.Prj is
-- generated file. -- generated file.
if Is_Obj (Name_Buffer (1 .. Name_Len)) 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 then
-- Get the object file time stamp -- Get the object file time stamp
......
gcc/ada/mlib.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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; ...@@ -27,7 +27,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling;
with Interfaces.C.Strings; with Interfaces.C.Strings;
with System; with System;
with Hostparm;
with Opt; with Opt;
with Output; use Output; with Output; use Output;
...@@ -459,12 +458,4 @@ package body MLib is ...@@ -459,12 +458,4 @@ package body MLib is
return Separate_Paths; return Separate_Paths;
end Separate_Run_Path_Options; end Separate_Run_Path_Options;
-- Package elaboration
begin
-- Copy_Attributes always fails on VMS
if Hostparm.OpenVMS then
Preserve := None;
end if;
end MLib; end MLib;
gcc/ada/mlib.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -91,7 +91,6 @@ package MLib is ...@@ -91,7 +91,6 @@ package MLib is
private private
Preserve : Attribute := Time_Stamps; Preserve : Attribute := Time_Stamps;
-- Used by Copy_ALI_Files. Changed to None for OpenVMS, because -- Used by Copy_ALI_Files.
-- Copy_Attributes always fails on VMS.
end MLib; end MLib;
gcc/ada/tempdir.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -25,7 +25,6 @@ ...@@ -25,7 +25,6 @@
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Hostparm; use Hostparm;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
...@@ -33,9 +32,8 @@ package body Tempdir is ...@@ -33,9 +32,8 @@ package body Tempdir is
Tmpdir_Needs_To_Be_Displayed : Boolean := True; Tmpdir_Needs_To_Be_Displayed : Boolean := True;
Tmpdir : constant String := "TMPDIR"; Tmpdir : constant String := "TMPDIR";
Gnutmpdir : constant String := "GNUTMPDIR"; Temp_Dir : String_Access := new String'("");
Temp_Dir : String_Access := new String'("");
---------------------- ----------------------
-- Create_Temp_File -- -- Create_Temp_File --
...@@ -118,21 +116,7 @@ package body Tempdir is ...@@ -118,21 +116,7 @@ package body Tempdir is
begin begin
if Status then if Status then
Dir := Getenv (Tmpdir);
-- 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;
end if; end if;
Free (Temp_Dir); Free (Temp_Dir);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment