Commit 80211802 by Arnaud Charlet

[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
2014-07-31 Arnaud Charlet <charlet@adacore.com> 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 * gcc-interface/trans.c, gcc-interface/misc.c: Remove references
to VMS. Misc clean ups. to VMS. Misc clean ups.
......
...@@ -8178,9 +8178,8 @@ package body Einfo is ...@@ -8178,9 +8178,8 @@ package body Einfo is
return Empty; return Empty;
end if; end if;
-- For non-incomplete, non-private types, return the type itself -- For non-incomplete, non-private types, return the type itself Also
-- Also for entities that are not types at all return the entity -- for entities that are not types at all return the entity itself.
-- itself.
else else
return Id; return Id;
...@@ -8191,7 +8190,10 @@ package body Einfo is ...@@ -8191,7 +8190,10 @@ package body Einfo is
-- Vax_Float -- -- Vax_Float --
--------------- ---------------
-- To be removed ???
function Vax_Float (Id : E) return B is function Vax_Float (Id : E) return B is
pragma Unreferenced (Id);
begin begin
return False; return False;
end Vax_Float; end Vax_Float;
......
...@@ -38,7 +38,6 @@ with Exp_Pakd; use Exp_Pakd; ...@@ -38,7 +38,6 @@ with Exp_Pakd; use Exp_Pakd;
with Exp_Strm; use Exp_Strm; with Exp_Strm; use Exp_Strm;
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util; with Exp_Util; use Exp_Util;
with Exp_VFpt; use Exp_VFpt;
with Fname; use Fname; with Fname; use Fname;
with Freeze; use Freeze; with Freeze; use Freeze;
with Gnatvsn; use Gnatvsn; with Gnatvsn; use Gnatvsn;
...@@ -6401,12 +6400,6 @@ package body Exp_Attr is ...@@ -6401,12 +6400,6 @@ package body Exp_Attr is
begin begin
case Float_Rep (Btyp) is 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 -- The AAMP back end handles Valid for floating-point types
when AAMP => when AAMP =>
...@@ -7392,78 +7385,36 @@ package body Exp_Attr is ...@@ -7392,78 +7385,36 @@ package body Exp_Attr is
Fat_Type : out Entity_Id; Fat_Type : out Entity_Id;
Fat_Pkg : out RE_Id) Fat_Pkg : out RE_Id)
is is
Btyp : constant Entity_Id := Base_Type (T);
Rtyp : constant Entity_Id := Root_Type (T); Rtyp : constant Entity_Id := Root_Type (T);
Digs : constant Nat := UI_To_Int (Digits_Value (Btyp));
begin begin
-- If the base type is VAX float, then get appropriate VAX float type -- All we do is use the root type (historically this dealt with
-- VAX-float .. to be cleaned up further later ???)
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;
when 15 => Fat_Type := Rtyp;
Fat_Type := RTE (RE_Fat_IEEE_Long);
Fat_Pkg := RE_Attr_IEEE_Long;
when others => if Fat_Type = Standard_Short_Float then
raise Program_Error; Fat_Pkg := RE_Attr_Short_Float;
end case;
-- If neither the base type nor the root type is VAX_Native then VAX elsif Fat_Type = Standard_Float then
-- float is out of the picture, and we can just use the root type. Fat_Pkg := RE_Attr_Float;
else elsif Fat_Type = Standard_Long_Float then
Fat_Type := Rtyp; Fat_Pkg := RE_Attr_Long_Float;
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_Long_Float then elsif Fat_Type = Standard_Long_Long_Float then
Fat_Pkg := RE_Attr_Long_Long_Float; Fat_Pkg := RE_Attr_Long_Long_Float;
-- Universal real (which is its own root type) is treated as being -- Universal real (which is its own root type) is treated as being
-- equivalent to Standard.Long_Long_Float, since it is defined to -- equivalent to Standard.Long_Long_Float, since it is defined to
-- have the same precision as the longest Float type. -- have the same precision as the longest Float type.
elsif Fat_Type = Universal_Real then elsif Fat_Type = Universal_Real then
Fat_Type := Standard_Long_Long_Float; Fat_Type := Standard_Long_Long_Float;
Fat_Pkg := RE_Attr_Long_Long_Float; Fat_Pkg := RE_Attr_Long_Long_Float;
else else
raise Program_Error; raise Program_Error;
end if;
end if; end if;
end Find_Fat_Info; end Find_Fat_Info;
......
...@@ -2161,29 +2161,6 @@ package body Exp_Ch11 is ...@@ -2161,29 +2161,6 @@ package body Exp_Ch11 is
end case; end case;
end Get_RT_Exception_Name; 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 -- -- Warn_If_No_Propagation --
---------------------------- ----------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- --
...@@ -83,11 +83,6 @@ package Exp_Ch11 is ...@@ -83,11 +83,6 @@ package Exp_Ch11 is
-- the Rcheck procedure for Code. The name is appended to Namet.Name_Buffer -- the Rcheck procedure for Code. The name is appended to Namet.Name_Buffer
-- without the __gnat_rcheck_ prefix. -- 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); procedure Possible_Local_Raise (N : Node_Id; E : Entity_Id);
-- This procedure is called whenever node N might cause the back end -- This procedure is called whenever node N might cause the back end
-- to generate a local raise for a local Constraint/Program/Storage_Error -- to generate a local raise for a local Constraint/Program/Storage_Error
......
...@@ -6926,11 +6926,9 @@ package body Sem_Attr is ...@@ -6926,11 +6926,9 @@ package body Sem_Attr is
------------------ ------------------
function Is_VAX_Float (Typ : Entity_Id) return Boolean is function Is_VAX_Float (Typ : Entity_Id) return Boolean is
pragma Unreferenced (Typ);
begin begin
return return False;
Is_Floating_Point_Type (Typ)
and then
(Float_Format = 'V' or else Float_Rep (Typ) = VAX_Native);
end Is_VAX_Float; end Is_VAX_Float;
-------------- --------------
......
...@@ -74,17 +74,17 @@ package body Sem_Ch4 is ...@@ -74,17 +74,17 @@ package body Sem_Ch4 is
-- operand has been analyzed. See Analyze_Concatenation for details. -- operand has been analyzed. See Analyze_Concatenation for details.
procedure Analyze_Expression (N : Node_Id); procedure Analyze_Expression (N : Node_Id);
-- For expressions that are not names, this is just a call to analyze. -- For expressions that are not names, this is just a call to analyze. If
-- If the expression is a name, it may be a call to a parameterless -- the expression is a name, it may be a call to a parameterless function,
-- function, and if so must be converted into an explicit call node -- and if so must be converted into an explicit call node and analyzed as
-- and analyzed as such. This deproceduring must be done during the first -- such. This deproceduring must be done during the first pass of overload
-- pass of overload resolution, because otherwise a procedure call with -- resolution, because otherwise a procedure call with overloaded actuals
-- overloaded actuals may fail to resolve. -- may fail to resolve.
procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id); 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 -- Analyze a call of the form "+"(x, y), etc. The prefix of the call is an
-- is an operator name or an expanded name whose selector is an operator -- operator name or an expanded name whose selector is an operator name,
-- name, and one possible interpretation is as a predefined operator. -- and one possible interpretation is as a predefined operator.
procedure Analyze_Overloaded_Selected_Component (N : Node_Id); procedure Analyze_Overloaded_Selected_Component (N : Node_Id);
-- If the prefix of a selected_component is overloaded, the proper -- If the prefix of a selected_component is overloaded, the proper
...@@ -132,7 +132,7 @@ package body Sem_Ch4 is ...@@ -132,7 +132,7 @@ package body Sem_Ch4 is
procedure Check_Misspelled_Selector procedure Check_Misspelled_Selector
(Prefix : Entity_Id; (Prefix : Entity_Id;
Sel : Node_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 -- spelling of one of the selectors of the Prefix. This is called by
-- Analyze_Selected_Component after producing an invalid selector error -- Analyze_Selected_Component after producing an invalid selector error
-- message. -- message.
...@@ -147,16 +147,16 @@ package body Sem_Ch4 is ...@@ -147,16 +147,16 @@ package body Sem_Ch4 is
(L, R : Node_Id; (L, R : Node_Id;
Op_Id : Entity_Id; Op_Id : Entity_Id;
N : Node_Id); N : Node_Id);
-- L and R are the operands of an arithmetic operator. Find -- L and R are the operands of an arithmetic operator. Find consistent
-- consistent pairs of interpretations for L and R that have a -- pairs of interpretations for L and R that have a numeric type consistent
-- numeric type consistent with the semantics of the operator. -- with the semantics of the operator.
procedure Find_Comparison_Types procedure Find_Comparison_Types
(L, R : Node_Id; (L, R : Node_Id;
Op_Id : Entity_Id; Op_Id : Entity_Id;
N : Node_Id); N : Node_Id);
-- L and R are operands of a comparison operator. Find consistent -- L and R are operands of a comparison operator. Find consistent pairs of
-- pairs of interpretations for L and R. -- interpretations for L and R.
procedure Find_Concatenation_Types procedure Find_Concatenation_Types
(L, R : Node_Id; (L, R : Node_Id;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -42,7 +42,6 @@ package body Sem_VFpt is ...@@ -42,7 +42,6 @@ package body Sem_VFpt is
Init_Size (Base_Type (E), 64); Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E)); Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXDF_Digits); Init_Digits_Value (Base_Type (E), VAXDF_Digits);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E)); Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64); Init_Size (E, 64);
...@@ -62,7 +61,6 @@ package body Sem_VFpt is ...@@ -62,7 +61,6 @@ package body Sem_VFpt is
Init_Size (Base_Type (E), 32); Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E)); Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXFF_Digits); Init_Digits_Value (Base_Type (E), VAXFF_Digits);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E)); Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32); Init_Size (E, 32);
...@@ -82,7 +80,6 @@ package body Sem_VFpt is ...@@ -82,7 +80,6 @@ package body Sem_VFpt is
Init_Size (Base_Type (E), 64); Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E)); Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXGF_Digits); Init_Digits_Value (Base_Type (E), VAXGF_Digits);
Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E)); Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64); Init_Size (E, 64);
......
...@@ -225,26 +225,8 @@ package body Set_Targ is ...@@ -225,26 +225,8 @@ package body Set_Targ is
Write_Str ("pragma Float_Representation ("); Write_Str ("pragma Float_Representation (");
case Float_Rep is case Float_Rep is
when IEEE_Binary => when IEEE_Binary => Write_Str ("IEEE");
Write_Str ("IEEE"); when AAMP => Write_Str ("AAMP");
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");
end case; end case;
Write_Line (", " & T (1 .. Last) & ");"); Write_Line (", " & T (1 .. Last) & ");");
...@@ -459,8 +441,6 @@ package body Set_Targ is ...@@ -459,8 +441,6 @@ package body Set_Targ is
case E.FLOAT_REP is case E.FLOAT_REP is
when IEEE_Binary => when IEEE_Binary =>
AddC ('I'); AddC ('I');
when VAX_Native =>
AddC ('V');
when AAMP => when AAMP =>
AddC ('A'); AddC ('A');
end case; end case;
...@@ -709,8 +689,6 @@ package body Set_Targ is ...@@ -709,8 +689,6 @@ package body Set_Targ is
case Buffer (N) is case Buffer (N) is
when 'I' => when 'I' =>
E.FLOAT_REP := IEEE_Binary; E.FLOAT_REP := IEEE_Binary;
when 'V' =>
E.FLOAT_REP := VAX_Native;
when 'A' => when 'A' =>
E.FLOAT_REP := AAMP; E.FLOAT_REP := AAMP;
when others => 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