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.
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;
-- Vax_Float --
---------------
+ -- To be removed ???
+
function Vax_Float (Id : E) return B is
+ pragma Unreferenced (Id);
begin
return False;
end Vax_Float;
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;
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 =>
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;
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 --
----------------------------
-- --
-- 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- --
-- 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
------------------
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;
--------------
-- 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
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.
(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;
-- --
-- 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- --
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);
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);
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);
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) & ");");
case E.FLOAT_REP is
when IEEE_Binary =>
AddC ('I');
- when VAX_Native =>
- AddC ('V');
when AAMP =>
AddC ('A');
end case;
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 =>
projects / platform / upstream / linaro-gcc.git / commitdiff