Skip to content

R
riscv-gcc-1
Commit 78f8727c by Robert Dewar Committed by Arnaud Charlet
Options

snames.ads-tmpl, [...]: Remove VMS-specific code. 

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* snames.ads-tmpl, s-os_lib.adb, s-os_lib.ads, s-fileio.adb: Remove
	VMS-specific code.
	* prj-conf.adb: Minor reformatting.
	* xr_tabls.adb (Read_File): Restore code which was enabled on
	non VMS platforms before.
	* prj-env.adb (Initialize_Default_Project_Path): Ditto.
	* sem_ch5.adb: Minor reformatting.
	* lib-writ.adb, lib-writ.ads, bindgen.adb, sem_vfpt.adb,
	sem_vfpt.ads, ali.adb, ali.ads, opt.ads, bcheck.adb, exp_strm.adb:
	Remove VMS-specific code.

From-SVN: r213432
parent 7a5b62b0
Showing with 84 additions and 180 deletions
gcc/ada/ChangeLog
2014-08-01 Robert Dewar <dewar@adacore.com>
* snames.ads-tmpl, s-os_lib.adb, s-os_lib.ads, s-fileio.adb: Remove
VMS-specific code.
* prj-conf.adb: Minor reformatting.
* xr_tabls.adb (Read_File): Restore code which was enabled on
non VMS platforms before.
* prj-env.adb (Initialize_Default_Project_Path): Ditto.
* sem_ch5.adb: Minor reformatting.
* lib-writ.adb, lib-writ.ads, bindgen.adb, sem_vfpt.adb,
sem_vfpt.ads, ali.adb, ali.ads, opt.ads, bcheck.adb, exp_strm.adb:
Remove VMS-specific code.
2014-08-01 Vincent Celier <celier@adacore.com>
* make.adb (Await_Compile): Remove loop that was only needed
......
gcc/ada/ali.adb
......@@ -108,7 +108,6 @@ package body ALI is
-- ALI files that are read for a given processing run in gnatbind.
Dynamic_Elaboration_Checks_Specified := False;
Float_Format_Specified := ' ';
Locking_Policy_Specified := ' ';
No_Normalize_Scalars_Specified := False;
No_Object_Specified := False;
......@@ -876,7 +875,6 @@ package body ALI is
First_Sdep => No_Sdep_Id,
First_Specific_Dispatching => Specific_Dispatching.Last + 1,
First_Unit => No_Unit_Id,
Float_Format => 'I',
Last_Interrupt_State => Interrupt_States.Last,
Last_Sdep => No_Sdep_Id,
Last_Specific_Dispatching => Specific_Dispatching.Last,
......@@ -1091,12 +1089,6 @@ package body ALI is
ALIs.Table (Id).Partition_Elaboration_Policy :=
Partition_Elaboration_Policy_Specified;
-- Processing for FD/FG/FI
elsif C = 'F' then
Float_Format_Specified := Getc;
ALIs.Table (Id).Float_Format := Float_Format_Specified;
-- Processing for Lx
elsif C = 'L' then
......
gcc/ada/ali.ads
......@@ -176,10 +176,6 @@ package ALI is
-- always be set as well in this case. Not set if 'P' appears in
-- Ignore_Lines.
Float_Format : Character;
-- Set to float format (set to I if no float-format given). Not set if
-- 'P' appears in Ignore_Lines.
No_Object : Boolean;
-- Set to True if no object file generated. Not set if 'P' appears in
-- Ignore_Lines.
......@@ -469,11 +465,6 @@ package ALI is
-- Set to False by Initialize_ALI. Set to True if Scan_ALI reads
-- a unit for which dynamic elaboration checking is enabled.
Float_Format_Specified : Character := ' ';
-- Set to blank by Initialize_ALI. Set to appropriate float format
-- character (V or I, see Opt.Float_Format) if an ali file that
-- is read contains an F line setting the floating point format.
Initialize_Scalars_Used : Boolean := False;
-- Set True if an ali file contains the Initialize_Scalars flag
......
gcc/ada/bcheck.adb
......@@ -47,7 +47,6 @@ package body Bcheck is
procedure Check_Consistent_Dispatching_Policy;
procedure Check_Consistent_Dynamic_Elaboration_Checking;
procedure Check_Consistent_Floating_Point_Format;
procedure Check_Consistent_Interrupt_States;
procedure Check_Consistent_Locking_Policy;
procedure Check_Consistent_Normalize_Scalars;
......@@ -73,10 +72,6 @@ package body Bcheck is
procedure Check_Configuration_Consistency is
begin
if Float_Format_Specified /= ' ' then
Check_Consistent_Floating_Point_Format;
end if;
if Queuing_Policy_Specified /= ' ' then
Check_Consistent_Queuing_Policy;
end if;
......@@ -526,41 +521,6 @@ package body Bcheck is
end if;
end Check_Consistent_Dynamic_Elaboration_Checking;
--------------------------------------------
-- Check_Consistent_Floating_Point_Format --
--------------------------------------------
-- The rule is that all files must be compiled with the same setting
-- for the floating-point format.
procedure Check_Consistent_Floating_Point_Format is
begin
-- First search for a unit specifying a floating-point format and then
-- check all remaining units against it.
Find_Format : for A1 in ALIs.First .. ALIs.Last loop
if ALIs.Table (A1).Float_Format /= ' ' then
Check_Format : declare
Format : constant Character := ALIs.Table (A1).Float_Format;
begin
for A2 in A1 + 1 .. ALIs.Last loop
if ALIs.Table (A2).Float_Format /= Format then
Error_Msg_File_1 := ALIs.Table (A1).Sfile;
Error_Msg_File_2 := ALIs.Table (A2).Sfile;
Consistency_Error_Msg
("{ and { compiled with different " &
"floating-point representations");
exit Find_Format;
end if;
end loop;
end Check_Format;
exit Find_Format;
end if;
end loop Find_Format;
end Check_Consistent_Floating_Point_Format;
---------------------------------------
-- Check_Consistent_Interrupt_States --
---------------------------------------
......
gcc/ada/bindgen.adb
......@@ -159,10 +159,6 @@ package body Bindgen is
-- A value of zero indicates that time slicing should be suppressed. If no
-- pragma is present, and no -T switch was used, the value is -1.
-- Float_Format is the float representation in use. Currently the only
-- valid value is 'I' for IEEE. We needed this field in the past for other
-- floating-point formats, and it is retained for possible future use.
-- WC_Encoding shows the wide character encoding method used for the main
-- program. This is one of the encoding letters defined in
-- System.WCh_Con.WC_Encoding_Letters.
......
gcc/ada/exp_strm.adb
......@@ -620,11 +620,14 @@ package body Exp_Strm is
-- and we are in the body of the default implementation of a 'Read
-- attribute, set target type to force a constraint check (13.13.2(35)).
-- If the type of the discriminant is currently private, add another
-- unchecked conversion from the full view.
if Nkind (Targ) = N_Identifier
and then Is_Internal_Name (Chars (Targ))
and then Is_TSS (Scope (Entity (Targ)), TSS_Stream_Read)
-- unchecked conversion from the full view. We also do this check if
-- this is an elementary read call in the source program (as opposed
-- to one generated as part of a composite read).
if (Nkind (Targ) = N_Identifier
and then Is_Internal_Name (Chars (Targ))
and then Is_TSS (Scope (Entity (Targ)), TSS_Stream_Read))
or else Comes_From_Source (N)
then
Res :=
Unchecked_Convert_To (Base_Type (U_Type),
......
gcc/ada/lib-writ.adb
......@@ -1133,20 +1133,6 @@ package body Lib.Writ is
Write_Info_Str (" DB");
end if;
if Opt.Float_Format /= ' ' then
Write_Info_Str (" F");
if Opt.Float_Format = 'I' then
Write_Info_Char ('I');
elsif Opt.Float_Format_Long = 'D' then
Write_Info_Char ('D');
else
Write_Info_Char ('G');
end if;
end if;
if Tasking_Used
and then not Is_Predefined_File_Name (Unit_File_Name (Main_Unit))
then
......
gcc/ada/lib-writ.ads
......@@ -192,18 +192,6 @@ package Lib.Writ is
-- the units in this file, where x is the first character
-- (upper case) of the policy name (e.g. 'C' for Concurrent).
-- FD Configuration pragmas apply to all the units in this file
-- specifying a possibly non-standard floating point format
-- (VAX float with Long_Float using D_Float).
-- FG Configuration pragmas apply to all the units in this file
-- specifying a possibly non-standard floating point format
-- (VAX float with Long_Float using G_Float).
-- FI Configuration pragmas apply to all the units in this file
-- specifying a possibly non-standard floating point format
-- (IEEE Float).
-- Lx A valid Locking_Policy pragma applies to all the units in
-- this file, where x is the first character (upper case) of
-- the policy name (e.g. 'C' for Ceiling_Locking).
......
gcc/ada/opt.ads
......@@ -639,19 +639,6 @@ package Opt is
-- Indicates the current setting of Fast_Math mode, as set by the use
-- of a Fast_Math pragma (set True by Fast_Math (On)).
Float_Format : Character := ' ';
-- GNAT
-- A non-blank value indicates that a Float_Format pragma has been
-- processed, in which case this variable is set to 'I' for IEEE or to
-- 'V' for VAX. The setting of 'V' is only possible on OpenVMS versions
-- of GNAT.
Float_Format_Long : Character := ' ';
-- GNAT
-- A non-blank value indicates that a Long_Float pragma has been processed
-- (this pragma is recognized only in OpenVMS versions of GNAT), in which
-- case this variable is set to D or G for D_Float or G_Float.
Force_ALI_Tree_File : Boolean := False;
-- GNAT
-- Force generation of ALI file even if errors are encountered. Also forces
......
gcc/ada/prj-conf.adb
......@@ -1418,7 +1418,7 @@ package body Prj.Conf is
-- This might raise an Invalid_Config exception
Do_Autoconf;
Do_Autoconf;
-- If the config file is not auto-generated, warn if there is any --RTS
-- switch, but not when the config file is generated in memory.
......
gcc/ada/prj-env.adb
......@@ -2040,6 +2040,32 @@ package body Prj.Env is
-- directory correctly.
Last := Last - 1;
else
declare
New_Dir : constant String :=
Normalize_Pathname
(Name_Buffer (First .. Last),
Resolve_Links => Opt.Follow_Links_For_Dirs);
New_Len : Natural;
New_Last : Natural;
begin
-- If the absolute path was resolved and is different from
-- the original, replace original with the resolved path.
if New_Dir /= Name_Buffer (First .. Last)
and then New_Dir'Length /= 0
then
New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
New_Last := First + New_Dir'Length - 1;
Name_Buffer (New_Last + 1 .. New_Len) :=
Name_Buffer (Last + 1 .. Name_Len);
Name_Buffer (First .. New_Last) := New_Dir;
Name_Len := New_Len;
Last := New_Last;
end if;
end;
end if;
First := Last + 1;
......
gcc/ada/s-os_lib.adb
......@@ -96,8 +96,8 @@ package body System.OS_Lib is
Stdout : Boolean);
-- Internal routine to implement two Create_Temp_File routines. If Stdout
-- is set to True the created descriptor is stdout-compatible, otherwise
-- it might not be depending on the OS (VMS is one example). The first two
-- parameters are as in Create_Temp_File.
-- it might not be depending on the OS. The first two parameters are as
-- in Create_Temp_File.
function C_String_Length (S : Address) return Integer;
-- Returns the length of C (null-terminated) string at S, or 0 for
......@@ -416,8 +416,8 @@ package body System.OS_Lib is
loop
R := Read (From, Buffer (1)'Address, Buf_Size);
-- For VMS, the buffer may not be full. So, we need to try again
-- until there is nothing to read.
-- On some systems, the buffer may not be full. So, we need to try
-- again until there is nothing to read.
exit when R = 0;
......@@ -2019,12 +2019,7 @@ package body System.OS_Lib is
end loop;
end if;
-- Resolve directory names for Windows (formerly also VMS)
-- On VMS, if we have a Unix path such as /temp/..., and TEMP is a
-- logical name, we must not try to resolve this logical name, because
-- it may have multiple equivalences and if resolved we will only
-- get the first one.
-- Resolve directory names for Windows
if On_Windows then
......
gcc/ada/s-os_lib.ads
......@@ -368,7 +368,7 @@ package System.OS_Lib is
-- effect of "cp -p" on Unix systems, and None corresponds to the typical
-- effect of "cp" on Unix systems.
-- Note: Time_Stamps and Full are not supported on VMS and VxWorks 5
-- Note: Time_Stamps and Full are not supported on VxWorks 5
procedure Copy_File
(Name : String;
......@@ -384,20 +384,14 @@ package System.OS_Lib is
-- True or False indicating if the copy is successful (depending on the
-- specified Mode).
--
-- Note: this procedure is only supported to a very limited extent on VMS.
-- The only supported mode is Overwrite, and the only supported value for
-- Preserve is None, resulting in the default action which for Overwrite
-- is to leave attributes unchanged. Furthermore, the copy only works for
-- simple text files.
procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean);
-- Copy Source file time stamps (last modification and last access time
-- stamps) to Dest file. Source and Dest must be valid filenames,
-- furthermore Dest must be writable. Success will be set to True if the
-- operation was successful and False otherwise.
--
-- Note: this procedure is not supported on VMS and VxWorks 5. On these
-- platforms, Success is always set to False.
-- Note: this procedure is not supported on VxWorks 5. On this platform,
-- Success is always set to False.
procedure Set_File_Last_Modify_Time_Stamp (Name : String; Time : OS_Time);
-- Given the name of a file or directory, Name, set the last modification
......@@ -484,17 +478,13 @@ package System.OS_Lib is
-- e.g. A is a symbolic link for B, and B is a symbolic link for A), then
-- Normalize_Pathname returns an empty string.
--
-- In VMS, if Name follows the VMS syntax file specification, it is first
-- converted into Unix syntax. If the conversion fails, Normalize_Pathname
-- returns an empty string.
--
-- For case-sensitive file systems, the value of Case_Sensitive parameter
-- is ignored. For file systems that are not case-sensitive, such as
-- Windows and OpenVMS, if this parameter is set to False, then the file
-- and directory names are folded to lower case. This allows checking
-- whether two files are the same by applying this function to their names
-- and comparing the results. If Case_Sensitive is set to True, this
-- function does not change the casing of file and directory names.
-- Windows, if this parameter is set to False, then the file and directory
-- names are folded to lower case. This allows checking whether two files
-- are the same by applying this function to their names and comparing the
-- results. If Case_Sensitive is set to True, this function does not change
-- the casing of file and directory names.
function Is_Absolute_Path (Name : String) return Boolean;
-- Returns True if Name is an absolute path name, i.e. it designates a
......@@ -894,7 +884,7 @@ package System.OS_Lib is
-- On Solaris: fork1, followed in the child process by execv
-- On other Unix-like systems, and on VMS: fork, followed in the child
-- On other Unix-like systems: fork, followed in the child
-- process by execv.
-- On vxworks, nucleus, and RTX, spawning of processes is not supported
......@@ -960,7 +950,7 @@ package System.OS_Lib is
-- set an explicit null as the value, or to remove the entry, this is
-- operating system dependent). Note that any following calls to Spawn
-- will pass an environment to the spawned process that includes the
-- changes made by Setenv calls. This procedure is not available on VMS.
-- changes made by Setenv calls.
procedure OS_Exit (Status : Integer);
pragma No_Return (OS_Exit);
......
gcc/ada/sem_ch5.adb
......@@ -1753,8 +1753,9 @@ package body Sem_Ch5 is
if not Is_Array_Type (Etype (Iter_Name)) then
declare
Iterator : constant Entity_Id :=
Find_Value_Of_Aspect
(Etype (Iter_Name), Aspect_Default_Iterator);
Find_Value_Of_Aspect
(Etype (Iter_Name), Aspect_Default_Iterator);
I : Interp_Index;
It : Interp;
......@@ -1852,11 +1853,11 @@ package body Sem_Ch5 is
-- The name in the renaming declaration may be a function call.
-- Indicate that it does not come from source, to suppress
-- spurious warnings on renamings of parameterless functions,
-- a common enough idiom in user-defined iterators.
-- The entity of the renaming must be a variable, because user-
-- defined Iterate function may have in-out parameters, even
-- if predefined ones do not.
-- spurious warnings on renamings of parameterless functions, a
-- common enough idiom in user-defined iterators. The entity of
-- the renaming must be a variable, because user- defined Iterate
-- function may have in-out parameters, even if predefined ones do
-- not.
Decl :=
Make_Object_Renaming_Declaration (Loc,
......
gcc/ada/sem_vfpt.adb
......@@ -23,11 +23,9 @@
-- --
------------------------------------------------------------------------------
with CStand; use CStand;
with Einfo; use Einfo;
with Opt; use Opt;
with Stand; use Stand;
with Targparm; use Targparm;
with CStand; use CStand;
with Einfo; use Einfo;
with Stand; use Stand;
package body Sem_VFpt is
......@@ -134,32 +132,9 @@ package body Sem_VFpt is
procedure Set_Standard_Fpt_Formats is
begin
-- IEEE case
if Opt.Float_Format = 'I' then
Set_IEEE_Short (Standard_Float);
Set_IEEE_Long (Standard_Long_Float);
Set_IEEE_Long (Standard_Long_Long_Float);
-- Vax float case
else
Set_F_Float (Standard_Float);
if Opt.Float_Format_Long = 'D' then
Set_D_Float (Standard_Long_Float);
else
Set_G_Float (Standard_Long_Float);
end if;
-- Note: Long_Long_Float gets set only in the real VMS case,
-- because this gives better results for testing out the use
-- of VAX float on non-VMS environments with the -gnatdm switch.
if OpenVMS_On_Target then
Set_G_Float (Standard_Long_Long_Float);
end if;
end if;
Set_IEEE_Short (Standard_Float);
Set_IEEE_Long (Standard_Long_Float);
Set_IEEE_Long (Standard_Long_Long_Float);
end Set_Standard_Fpt_Formats;
end Sem_VFpt;
gcc/ada/sem_vfpt.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1997-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- --
......
gcc/ada/snames.ads-tmpl
......@@ -499,7 +499,7 @@ package Snames is
Name_External : constant Name_Id := N + $; -- GNAT
Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT
Name_Global : constant Name_Id := N + $; -- GNAT
Name_Ident : constant Name_Id := N + $; -- VMS
Name_Ident : constant Name_Id := N + $; -- GNAT
Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT
Name_Implemented : constant Name_Id := N + $; -- Ada 12
Name_Import : constant Name_Id := N + $;
......@@ -801,7 +801,6 @@ package Snames is
Name_Variant : constant Name_Id := N + $;
Name_VAX_Float : constant Name_Id := N + $;
Name_Vector : constant Name_Id := N + $;
Name_VMS : constant Name_Id := N + $;
Name_Vtable_Ptr : constant Name_Id := N + $;
Name_Warn : constant Name_Id := N + $;
Name_Working_Storage : constant Name_Id := N + $;
......@@ -814,9 +813,6 @@ package Snames is
-- implemented in all Ada modes. Full descriptions of these implementation
-- dependent attributes may be found in the appropriate Sem_Attr section.
-- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts.
First_Attribute_Name : constant Name_Id := N + $;
Name_Abort_Signal : constant Name_Id := N + $; -- GNAT
Name_Access : constant Name_Id := N + $;
......
gcc/ada/xr_tabls.adb
......@@ -1135,6 +1135,11 @@ package body Xr_Tabls is
Buffer (Read_Ptr) := EOF;
Contents := new String'(Buffer (1 .. Read_Ptr));
if Read_Ptr /= Length + 1 then
raise Ada.Text_IO.End_Error;
end if;
Close (FD);
end;
end Read_File;
......
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