Skip to content

R
riscv-gcc-1
Commit 80211802 by Arnaud Charlet
Options

[multiple changes] 

2014-07-31  Arnaud Charlet  <charlet@adacore.com>

	* einfo.adb: Remove VMS specific code.
	* exp_attr.adb: Remove VAX specific code.
	* set_targ.adb: Remove handling of VAX_Float.
	* sem_vfpt.adb: Remove references to Vax_Native.
	* sem_attr.adb (Is_VAX_Float): Remove ref to VAX_Native.

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb: Minor reformatting.

From-SVN: r213371
parent 3f1be5be
Showing with 54 additions and 144 deletions
gcc/ada/ChangeLog
2014-07-31 Arnaud Charlet <charlet@adacore.com>
* einfo.adb: Remove VMS specific code.
* exp_attr.adb: Remove VAX specific code.
* set_targ.adb: Remove handling of VAX_Float.
* sem_vfpt.adb: Remove references to Vax_Native.
* sem_attr.adb (Is_VAX_Float): Remove ref to VAX_Native.
2014-07-31 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb: Minor reformatting.
2014-07-31 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/trans.c, gcc-interface/misc.c: Remove references
to VMS. Misc clean ups.
......
gcc/ada/einfo.adb
......@@ -8178,9 +8178,8 @@ package body Einfo is
return Empty;
end if;
-- For non-incomplete, non-private types, return the type itself
-- Also for entities that are not types at all return the entity
-- itself.
-- For non-incomplete, non-private types, return the type itself Also
-- for entities that are not types at all return the entity itself.
else
return Id;
......@@ -8191,7 +8190,10 @@ package body Einfo is
-- Vax_Float --
---------------
-- To be removed ???
function Vax_Float (Id : E) return B is
pragma Unreferenced (Id);
begin
return False;
end Vax_Float;
......
gcc/ada/exp_attr.adb
......@@ -38,7 +38,6 @@ with Exp_Pakd; use Exp_Pakd;
with Exp_Strm; use Exp_Strm;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Exp_VFpt; use Exp_VFpt;
with Fname; use Fname;
with Freeze; use Freeze;
with Gnatvsn; use Gnatvsn;
......@@ -6401,12 +6400,6 @@ package body Exp_Attr is
begin
case Float_Rep (Btyp) is
-- For vax fpt types, call appropriate routine in special
-- vax floating point unit. No need to worry about loads in
-- this case, since these types have no signalling NaN's.
when VAX_Native => Expand_Vax_Valid (N);
-- The AAMP back end handles Valid for floating-point types
when AAMP =>
......@@ -7392,78 +7385,36 @@ package body Exp_Attr is
Fat_Type : out Entity_Id;
Fat_Pkg : out RE_Id)
is
Btyp : constant Entity_Id := Base_Type (T);
Rtyp : constant Entity_Id := Root_Type (T);
Digs : constant Nat := UI_To_Int (Digits_Value (Btyp));
begin
-- If the base type is VAX float, then get appropriate VAX float type
if Vax_Float (Btyp) then
case Digs is
when 6 =>
Fat_Type := RTE (RE_Fat_VAX_F);
Fat_Pkg := RE_Attr_VAX_F_Float;
when 9 =>
Fat_Type := RTE (RE_Fat_VAX_D);
Fat_Pkg := RE_Attr_VAX_D_Float;
when 15 =>
Fat_Type := RTE (RE_Fat_VAX_G);
Fat_Pkg := RE_Attr_VAX_G_Float;
when others =>
raise Program_Error;
end case;
-- If root type is VAX float, this is the case where the library has
-- been recompiled in VAX float mode, and we have an IEEE float type.
-- This is when we use the special IEEE Fat packages.
elsif Vax_Float (Rtyp) then
case Digs is
when 6 =>
Fat_Type := RTE (RE_Fat_IEEE_Short);
Fat_Pkg := RE_Attr_IEEE_Short;
-- All we do is use the root type (historically this dealt with
-- VAX-float .. to be cleaned up further later ???)
when 15 =>
Fat_Type := RTE (RE_Fat_IEEE_Long);
Fat_Pkg := RE_Attr_IEEE_Long;
Fat_Type := Rtyp;
when others =>
raise Program_Error;
end case;
if Fat_Type = Standard_Short_Float then
Fat_Pkg := RE_Attr_Short_Float;
-- If neither the base type nor the root type is VAX_Native then VAX
-- float is out of the picture, and we can just use the root type.
elsif Fat_Type = Standard_Float then
Fat_Pkg := RE_Attr_Float;
else
Fat_Type := Rtyp;
if Fat_Type = Standard_Short_Float then
Fat_Pkg := RE_Attr_Short_Float;
elsif Fat_Type = Standard_Float then
Fat_Pkg := RE_Attr_Float;
elsif Fat_Type = Standard_Long_Float then
Fat_Pkg := RE_Attr_Long_Float;
elsif Fat_Type = Standard_Long_Float then
Fat_Pkg := RE_Attr_Long_Float;
elsif Fat_Type = Standard_Long_Long_Float then
Fat_Pkg := RE_Attr_Long_Long_Float;
elsif Fat_Type = Standard_Long_Long_Float then
Fat_Pkg := RE_Attr_Long_Long_Float;
-- Universal real (which is its own root type) is treated as being
-- equivalent to Standard.Long_Long_Float, since it is defined to
-- have the same precision as the longest Float type.
elsif Fat_Type = Universal_Real then
Fat_Type := Standard_Long_Long_Float;
Fat_Pkg := RE_Attr_Long_Long_Float;
elsif Fat_Type = Universal_Real then
Fat_Type := Standard_Long_Long_Float;
Fat_Pkg := RE_Attr_Long_Long_Float;
else
raise Program_Error;
end if;
else
raise Program_Error;
end if;
end Find_Fat_Info;
......
gcc/ada/exp_ch11.adb
......@@ -2161,29 +2161,6 @@ package body Exp_Ch11 is
end case;
end Get_RT_Exception_Name;
----------------------
-- Is_Non_Ada_Error --
----------------------
function Is_Non_Ada_Error (E : Entity_Id) return Boolean is
begin
if not OpenVMS_On_Target then
return False;
end if;
Get_Name_String (Chars (E));
-- Note: it is a little irregular for the body of exp_ch11 to know
-- the details of the encoding scheme for names, but on the other
-- hand, gigi knows them, and this is for gigi's benefit anyway.
if Name_Buffer (1 .. 30) /= "system__aux_dec__non_ada_error" then
return False;
end if;
return True;
end Is_Non_Ada_Error;
----------------------------
-- Warn_If_No_Propagation --
----------------------------
......
gcc/ada/exp_ch11.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -83,11 +83,6 @@ package Exp_Ch11 is
-- the Rcheck procedure for Code. The name is appended to Namet.Name_Buffer
-- without the __gnat_rcheck_ prefix.
function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
-- This function is provided for Gigi use. It returns True if operating on
-- VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
-- This is used to generate the special matching code for this exception.
procedure Possible_Local_Raise (N : Node_Id; E : Entity_Id);
-- This procedure is called whenever node N might cause the back end
-- to generate a local raise for a local Constraint/Program/Storage_Error
......
gcc/ada/sem_attr.adb
......@@ -6926,11 +6926,9 @@ package body Sem_Attr is
------------------
function Is_VAX_Float (Typ : Entity_Id) return Boolean is
pragma Unreferenced (Typ);
begin
return
Is_Floating_Point_Type (Typ)
and then
(Float_Format = 'V' or else Float_Rep (Typ) = VAX_Native);
return False;
end Is_VAX_Float;
--------------
......
gcc/ada/sem_ch4.adb
......@@ -74,17 +74,17 @@ package body Sem_Ch4 is
-- operand has been analyzed. See Analyze_Concatenation for details.
procedure Analyze_Expression (N : Node_Id);
-- For expressions that are not names, this is just a call to analyze.
-- If the expression is a name, it may be a call to a parameterless
-- function, and if so must be converted into an explicit call node
-- and analyzed as such. This deproceduring must be done during the first
-- pass of overload resolution, because otherwise a procedure call with
-- overloaded actuals may fail to resolve.
-- For expressions that are not names, this is just a call to analyze. If
-- the expression is a name, it may be a call to a parameterless function,
-- and if so must be converted into an explicit call node and analyzed as
-- such. This deproceduring must be done during the first pass of overload
-- resolution, because otherwise a procedure call with overloaded actuals
-- may fail to resolve.
procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id);
-- Analyze a call of the form "+"(x, y), etc. The prefix of the call
-- is an operator name or an expanded name whose selector is an operator
-- name, and one possible interpretation is as a predefined operator.
-- Analyze a call of the form "+"(x, y), etc. The prefix of the call is an
-- operator name or an expanded name whose selector is an operator name,
-- and one possible interpretation is as a predefined operator.
procedure Analyze_Overloaded_Selected_Component (N : Node_Id);
-- If the prefix of a selected_component is overloaded, the proper
......@@ -132,7 +132,7 @@ package body Sem_Ch4 is
procedure Check_Misspelled_Selector
(Prefix : Entity_Id;
Sel : Node_Id);
-- Give possible misspelling diagnostic if Sel is likely to be a mis-
-- Give possible misspelling message if Sel seems likely to be a mis-
-- spelling of one of the selectors of the Prefix. This is called by
-- Analyze_Selected_Component after producing an invalid selector error
-- message.
......@@ -147,16 +147,16 @@ package body Sem_Ch4 is
(L, R : Node_Id;
Op_Id : Entity_Id;
N : Node_Id);
-- L and R are the operands of an arithmetic operator. Find
-- consistent pairs of interpretations for L and R that have a
-- numeric type consistent with the semantics of the operator.
-- L and R are the operands of an arithmetic operator. Find consistent
-- pairs of interpretations for L and R that have a numeric type consistent
-- with the semantics of the operator.
procedure Find_Comparison_Types
(L, R : Node_Id;
Op_Id : Entity_Id;
N : Node_Id);
-- L and R are operands of a comparison operator. Find consistent
-- pairs of interpretations for L and R.
-- L and R are operands of a comparison operator. Find consistent pairs of
-- interpretations for L and R.
procedure Find_Concatenation_Types
(L, R : Node_Id;
......
gcc/ada/sem_vfpt.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2010, 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- --
......@@ -42,7 +42,6 @@ package body Sem_VFpt is
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXDF_Digits);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
......@@ -62,7 +61,6 @@ package body Sem_VFpt is
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXFF_Digits);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
......@@ -82,7 +80,6 @@ package body Sem_VFpt is
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXGF_Digits);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
......
gcc/ada/set_targ.adb
......@@ -225,26 +225,8 @@ package body Set_Targ is
Write_Str ("pragma Float_Representation (");
case Float_Rep is
when IEEE_Binary =>
Write_Str ("IEEE");
when VAX_Native =>
case Digs is
when 6 =>
Write_Str ("VAXF");
when 9 =>
Write_Str ("VAXD");
when 15 =>
Write_Str ("VAXG");
when others =>
Write_Str ("VAX_");
Write_Int (Int (Digs));
end case;
when AAMP => Write_Str ("AAMP");
when IEEE_Binary => Write_Str ("IEEE");
when AAMP => Write_Str ("AAMP");
end case;
Write_Line (", " & T (1 .. Last) & ");");
......@@ -459,8 +441,6 @@ package body Set_Targ is
case E.FLOAT_REP is
when IEEE_Binary =>
AddC ('I');
when VAX_Native =>
AddC ('V');
when AAMP =>
AddC ('A');
end case;
......@@ -709,8 +689,6 @@ package body Set_Targ is
case Buffer (N) is
when 'I' =>
E.FLOAT_REP := IEEE_Binary;
when 'V' =>
E.FLOAT_REP := VAX_Native;
when 'A' =>
E.FLOAT_REP := AAMP;
when others =>
......
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