===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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;
===================================================================
@@ -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
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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;
------------------------
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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;
===================================================================
@@ -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;
===================================================================
@@ -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);
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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) := '_';
===================================================================
@@ -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
===================================================================
@@ -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.
===================================================================
@@ -60,7 +60,6 @@
-- GNU/Linux
-- HP-UX
-- Solaris
-- NOTE FOR FUTURE PLATFORMS SUPPORT: It is assumed that type Duration is
-- 64 bit. If the need arises to support architectures where this assumption
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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;
-
-begin
- -- Copy_Attributes always fails on VMS
-
- if Hostparm.OpenVMS then
- Preserve := None;
- end if;
end MLib;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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);