From 802118024ce85af98c40e5b354041a52d991493a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 31 Jul 2014 15:53:40 +0200 Subject: [PATCH] [multiple changes] 2014-07-31 Arnaud Charlet * 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 * sem_ch4.adb: Minor reformatting. From-SVN: r213371 --- gcc/ada/ChangeLog | 12 ++++++++ gcc/ada/einfo.adb | 8 ++++-- gcc/ada/exp_attr.adb | 81 +++++++++++----------------------------------------- gcc/ada/exp_ch11.adb | 23 --------------- gcc/ada/exp_ch11.ads | 7 +---- gcc/ada/sem_attr.adb | 6 ++-- gcc/ada/sem_ch4.adb | 30 +++++++++---------- gcc/ada/sem_vfpt.adb | 5 +--- gcc/ada/set_targ.adb | 26 ++--------------- 9 files changed, 54 insertions(+), 144 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1333672..db882b0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,17 @@ 2014-07-31 Arnaud Charlet + * 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 + + * sem_ch4.adb: Minor reformatting. + +2014-07-31 Arnaud Charlet + * gcc-interface/trans.c, gcc-interface/misc.c: Remove references to VMS. Misc clean ups. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 664d24b..a3e77a8 100644 --- a/gcc/ada/einfo.adb +++ b/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; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index e2ec15d..a90b777 100644 --- a/gcc/ada/exp_attr.adb +++ b/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; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index a464aaa..a1aadc2 100644 --- a/gcc/ada/exp_ch11.adb +++ b/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 -- ---------------------------- diff --git a/gcc/ada/exp_ch11.ads b/gcc/ada/exp_ch11.ads index 5fd123e..ab93d5d 100644 --- a/gcc/ada/exp_ch11.ads +++ b/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 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index bff4539..e0d2d9e 100644 --- a/gcc/ada/sem_attr.adb +++ b/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; -------------- diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 7b29697..7cbf593 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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; diff --git a/gcc/ada/sem_vfpt.adb b/gcc/ada/sem_vfpt.adb index 5ea780a..d81298e 100644 --- a/gcc/ada/sem_vfpt.adb +++ b/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); diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb index 704bea6..46f40cc 100755 --- a/gcc/ada/set_targ.adb +++ b/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 => -- 2.7.4