[multiple changes]
2015-01-06 Robert Dewar <dewar@adacore.com> * s-valllu.adb, a-tiinau.adb, a-timoau.adb, a-ztinau.adb, a-ztmoau.adb, s-valuns.adb, s-valrea.adb, a-wtflau.adb, a-tiflau.adb, a-ztflau.adb, a-wtinau.adb, a-wtmoau.adb: Document recognition of : in place of #. 2015-01-06 Ed Schonberg <schonberg@adacore.com> * sem_ch13.adb (Analyze_Aspect_Specifications): For aspects that specify stream subprograms, if the prefix is a class-wide type then the generated attribute definition clause must apply to the same class-wide type. (Default_Iterator): An iterator defined by an aspect of some container type T must have a first parameter of type T, T'class, or an access to such (from code reading RM 5.5.1 (2/3)). 2015-01-06 Arnaud Charlet <charlet@adacore.com> * gnat1drv.adb: Minor: complete previous change. 2015-01-06 Olivier Hainque <hainque@adacore.com> * set_targ.ads (C_Type_For): New function. Return the name of a C type supported by the back-end and suitable as a basis to construct the standard Ada floating point type identified by the T parameter. This is used as a common ground to feed both ttypes values and the GNAT tree nodes for the standard floating point types. * set_targ.adb (Long_Double_Index): The index at which "long double" gets registered in the FPT_Mode_Table. This is useful to know whether we have a "long double" available at all and get at it's characteristics without having to search the FPT_Mode_Table when we need to decide which C type should be used as the basis for Long_Long_Float in Ada. (Register_Float_Type): Fill Long_Double_Index. (FPT_Mode_Index_For): New function. Return the index in FPT_Mode_Table that designates the entry corresponding to the provided C type name. (FPT_Mode_Index_For): New function. Return the index in FPT_Mode_Table that designates the entry for a back-end type suitable as a basis to construct the standard Ada floating point type identified by the input T parameter. (elaboration code): Register_Back_End_Types unconditionally, so C_Type_For can operate regardless of -gnateT. Do it early so we can query it for the floating point sizes, via FPT_Mode_Index_For. Initialize Float_Size, Double_Size and Long_Double_Size from the FPT_Mode_Table, as cstand will do. * cstand.adb (Create_Float_Types): Use C_Type_For to determine which C type should be used as the basis for the construction of the Standard Ada floating point types. * get_targ.ads (Get_Float_Size, Get_Double_Size, Get_Long_Double_Size): Remove. * get_targ.adb: Likewise. 2015-01-06 Thomas Quinot <quinot@adacore.com> * sem_cat.adb (In_RCI_Declaration): Remove unnecessary parameter and rename to... (In_RCI_Visible_Declarations): Fix handling of private part of nested package. (Validate_RCI_Subprogram_Declaration): Reject illegal function returning anonymous access in RCI unit. From-SVN: r219233
This commit is contained in:
Arnaud Charlet
parent
948ed27746
commit
72eaa36512
|
|
@ -1,3 +1,66 @@
|
|||
2015-01-06 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* s-valllu.adb, a-tiinau.adb, a-timoau.adb, a-ztinau.adb, a-ztmoau.adb,
|
||||
s-valuns.adb, s-valrea.adb, a-wtflau.adb, a-tiflau.adb, a-ztflau.adb,
|
||||
a-wtinau.adb, a-wtmoau.adb: Document recognition of : in place of #.
|
||||
|
||||
2015-01-06 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Analyze_Aspect_Specifications): For aspects
|
||||
that specify stream subprograms, if the prefix is a class-wide
|
||||
type then the generated attribute definition clause must apply
|
||||
to the same class-wide type.
|
||||
(Default_Iterator): An iterator defined by an aspect of some
|
||||
container type T must have a first parameter of type T, T'class,
|
||||
or an access to such (from code reading RM 5.5.1 (2/3)).
|
||||
|
||||
2015-01-06 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* gnat1drv.adb: Minor: complete previous change.
|
||||
|
||||
2015-01-06 Olivier Hainque <hainque@adacore.com>
|
||||
|
||||
* set_targ.ads (C_Type_For): New function. Return the name of
|
||||
a C type supported by the back-end and suitable as a basis to
|
||||
construct the standard Ada floating point type identified by
|
||||
the T parameter. This is used as a common ground to feed both
|
||||
ttypes values and the GNAT tree nodes for the standard floating
|
||||
point types.
|
||||
* set_targ.adb (Long_Double_Index): The index at which "long
|
||||
double" gets registered in the FPT_Mode_Table. This is useful to
|
||||
know whether we have a "long double" available at all and get at
|
||||
it's characteristics without having to search the FPT_Mode_Table
|
||||
when we need to decide which C type should be used as the
|
||||
basis for Long_Long_Float in Ada.
|
||||
(Register_Float_Type): Fill Long_Double_Index.
|
||||
(FPT_Mode_Index_For): New function. Return the index in
|
||||
FPT_Mode_Table that designates the entry corresponding to the
|
||||
provided C type name.
|
||||
(FPT_Mode_Index_For): New function. Return the index in
|
||||
FPT_Mode_Table that designates the entry for a back-end type
|
||||
suitable as a basis to construct the standard Ada floating point
|
||||
type identified by the input T parameter.
|
||||
(elaboration code): Register_Back_End_Types unconditionally,
|
||||
so C_Type_For can operate regardless of -gnateT. Do it
|
||||
early so we can query it for the floating point sizes, via
|
||||
FPT_Mode_Index_For. Initialize Float_Size, Double_Size and
|
||||
Long_Double_Size from the FPT_Mode_Table, as cstand will do.
|
||||
* cstand.adb (Create_Float_Types): Use C_Type_For to determine
|
||||
which C type should be used as the basis for the construction
|
||||
of the Standard Ada floating point types.
|
||||
* get_targ.ads (Get_Float_Size, Get_Double_Size,
|
||||
Get_Long_Double_Size): Remove.
|
||||
* get_targ.adb: Likewise.
|
||||
|
||||
2015-01-06 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* sem_cat.adb (In_RCI_Declaration): Remove unnecessary
|
||||
parameter and rename to...
|
||||
(In_RCI_Visible_Declarations): Fix handling of private part of nested
|
||||
package.
|
||||
(Validate_RCI_Subprogram_Declaration): Reject illegal function
|
||||
returning anonymous access in RCI unit.
|
||||
|
||||
2015-01-06 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb (New_Overloaded_Entity): In GNATprove mode, a
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -124,7 +124,8 @@ package body Ada.Text_IO.Float_Aux is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Based cases
|
||||
-- Based cases. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -166,7 +166,8 @@ package body Ada.Text_IO.Integer_Aux is
|
|||
|
||||
if Loaded then
|
||||
|
||||
-- Deal with based literal (note : is ok replacement for #)
|
||||
-- Deal with based literal. We recognize either the standard '#' or
|
||||
-- the allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -173,6 +173,10 @@ package body Ada.Text_IO.Modular_Aux is
|
|||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -124,7 +124,8 @@ package body Ada.Wide_Text_IO.Float_Aux is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Based cases
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -165,6 +165,10 @@ package body Ada.Wide_Text_IO.Integer_Aux is
|
|||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -173,6 +173,10 @@ package body Ada.Wide_Text_IO.Modular_Aux is
|
|||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -124,7 +124,8 @@ package body Ada.Wide_Wide_Text_IO.Float_Aux is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Based cases
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, 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- --
|
||||
|
|
@ -165,6 +165,10 @@ package body Ada.Wide_Wide_Text_IO.Integer_Aux is
|
|||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
|
|
|||
|
|
@ -173,6 +173,10 @@ package body Ada.Wide_Wide_Text_IO.Modular_Aux is
|
|||
Load_Digits (File, Buf, Ptr, Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
Load (File, Buf, Ptr, '#', ':', Loaded);
|
||||
|
||||
if Loaded then
|
||||
|
|
|
|||
|
|
@ -504,45 +504,26 @@ package body CStand is
|
|||
|
||||
Copy_Float_Type
|
||||
(Standard_Short_Float,
|
||||
Find_Back_End_Float_Type ("float"));
|
||||
Find_Back_End_Float_Type (C_Type_For (S_Short_Float)));
|
||||
Set_Is_Implementation_Defined (Standard_Short_Float);
|
||||
|
||||
Copy_Float_Type (Standard_Float, Standard_Short_Float);
|
||||
|
||||
Copy_Float_Type (Standard_Long_Float,
|
||||
Find_Back_End_Float_Type ("double"));
|
||||
Copy_Float_Type
|
||||
(Standard_Long_Float,
|
||||
Find_Back_End_Float_Type (C_Type_For (S_Long_Float)));
|
||||
|
||||
Copy_Float_Type
|
||||
(Standard_Long_Long_Float,
|
||||
Find_Back_End_Float_Type (C_Type_For (S_Long_Long_Float)));
|
||||
Set_Is_Implementation_Defined (Standard_Long_Long_Float);
|
||||
|
||||
Predefined_Float_Types := New_Elmt_List;
|
||||
|
||||
Append_Elmt (Standard_Short_Float, Predefined_Float_Types);
|
||||
Append_Elmt (Standard_Float, Predefined_Float_Types);
|
||||
Append_Elmt (Standard_Long_Float, Predefined_Float_Types);
|
||||
|
||||
-- ??? For now, we don't have a good way to tell the widest float
|
||||
-- type with hardware support. Basically, GCC knows the size of that
|
||||
-- type, but on x86-64 there often are two or three 128-bit types,
|
||||
-- one double extended that has 18 decimal digits, a 128-bit quad
|
||||
-- precision type with 33 digits and possibly a 128-bit decimal float
|
||||
-- type with 34 digits. As a workaround, we define Long_Long_Float as
|
||||
-- C's "long double" if that type exists and has at most 18 digits,
|
||||
-- or otherwise the same as Long_Float.
|
||||
|
||||
declare
|
||||
Max_HW_Digs : constant := 18;
|
||||
-- Maximum hardware digits supported
|
||||
|
||||
LLF : Entity_Id := Find_Back_End_Float_Type ("long double");
|
||||
-- Entity for long double type
|
||||
|
||||
begin
|
||||
if No (LLF) or else Digits_Value (LLF) > Max_HW_Digs then
|
||||
LLF := Standard_Long_Float;
|
||||
end if;
|
||||
|
||||
Set_Is_Implementation_Defined (Standard_Long_Long_Float);
|
||||
Copy_Float_Type (Standard_Long_Long_Float, LLF);
|
||||
|
||||
Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);
|
||||
end;
|
||||
Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);
|
||||
|
||||
-- Any other back end types are appended at the end of the list of
|
||||
-- predefined float types, and will only be selected if the none of
|
||||
|
|
|
|||
|
|
@ -126,42 +126,6 @@ package body Get_Targ is
|
|||
return C_Get_Long_Long_Size;
|
||||
end Get_Long_Long_Size;
|
||||
|
||||
--------------------
|
||||
-- Get_Float_Size --
|
||||
--------------------
|
||||
|
||||
function Get_Float_Size return Pos is
|
||||
function C_Get_Float_Size return Pos;
|
||||
pragma Import (C, C_Get_Float_Size,
|
||||
"get_target_float_size");
|
||||
begin
|
||||
return C_Get_Float_Size;
|
||||
end Get_Float_Size;
|
||||
|
||||
---------------------
|
||||
-- Get_Double_Size --
|
||||
---------------------
|
||||
|
||||
function Get_Double_Size return Pos is
|
||||
function C_Get_Double_Size return Pos;
|
||||
pragma Import (C, C_Get_Double_Size,
|
||||
"get_target_double_size");
|
||||
begin
|
||||
return C_Get_Double_Size;
|
||||
end Get_Double_Size;
|
||||
|
||||
--------------------------
|
||||
-- Get_Long_Double_Size --
|
||||
--------------------------
|
||||
|
||||
function Get_Long_Double_Size return Pos is
|
||||
function C_Get_Long_Double_Size return Pos;
|
||||
pragma Import (C, C_Get_Long_Double_Size,
|
||||
"get_target_long_double_size");
|
||||
begin
|
||||
return C_Get_Long_Double_Size;
|
||||
end Get_Long_Double_Size;
|
||||
|
||||
----------------------
|
||||
-- Get_Pointer_Size --
|
||||
----------------------
|
||||
|
|
|
|||
|
|
@ -68,15 +68,6 @@ package Get_Targ is
|
|||
function Get_Long_Long_Size return Pos;
|
||||
-- Size of Standard.Long_Long_Integer
|
||||
|
||||
function Get_Float_Size return Pos;
|
||||
-- Size of Standard.Float
|
||||
|
||||
function Get_Double_Size return Pos;
|
||||
-- Size of Standard.Long_Float
|
||||
|
||||
function Get_Long_Double_Size return Pos;
|
||||
-- Size of Standard.Long_Long_Float
|
||||
|
||||
function Get_Pointer_Size return Pos;
|
||||
-- Size of System.Address
|
||||
|
||||
|
|
|
|||
|
|
@ -182,10 +182,11 @@ procedure Gnat1drv is
|
|||
|
||||
if CodePeer_Mode then
|
||||
|
||||
-- Turn off gnatprove mode (if set via e.g. -gnatd.F), not compatible
|
||||
-- with CodePeer mode.
|
||||
-- Turn off gnatprove mode (which can be set via e.g. -gnatd.F), not
|
||||
-- compatible with CodePeer mode.
|
||||
|
||||
GNATprove_Mode := False;
|
||||
Debug_Flag_Dot_FF := False;
|
||||
|
||||
-- Turn off inlining, confuses CodePeer output and gains nothing
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2012, 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- --
|
||||
|
|
@ -119,9 +119,10 @@ package body System.Val_LLU is
|
|||
|
||||
Ptr.all := P;
|
||||
|
||||
-- Deal with based case
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
if P < Max and then (Str (P) = ':' or else Str (P) = '#') then
|
||||
if P < Max and then (Str (P) = '#' or else Str (P) = ':') then
|
||||
Base_Char := Str (P);
|
||||
P := P + 1;
|
||||
Base := Uval;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2012, 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- --
|
||||
|
|
@ -183,9 +183,10 @@ package body System.Val_Real is
|
|||
Bad_Value (Str);
|
||||
end if;
|
||||
|
||||
-- Deal with based case
|
||||
-- Deal with based case. We reognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
if P < Max and then (Str (P) = ':' or else Str (P) = '#') then
|
||||
if P < Max and then (Str (P) = '#' or else Str (P) = ':') then
|
||||
declare
|
||||
Base_Char : constant Character := Str (P);
|
||||
Digit : Natural;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2012, 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- --
|
||||
|
|
@ -119,9 +119,10 @@ package body System.Val_Uns is
|
|||
|
||||
Ptr.all := P;
|
||||
|
||||
-- Deal with based case
|
||||
-- Deal with based case. We recognize either the standard '#' or the
|
||||
-- allowed alternative replacement ':' (see RM J.2(3)).
|
||||
|
||||
if P < Max and then (Str (P) = ':' or else Str (P) = '#') then
|
||||
if P < Max and then (Str (P) = '#' or else Str (P) = ':') then
|
||||
Base_Char := Str (P);
|
||||
P := P + 1;
|
||||
Base := Uval;
|
||||
|
|
|
|||
|
|
@ -86,10 +86,10 @@ package body Sem_Cat is
|
|||
-- Return True if the entity or one of its subcomponents does not support
|
||||
-- external streaming.
|
||||
|
||||
function In_RCI_Declaration (N : Node_Id) return Boolean;
|
||||
-- Determines if a declaration is within the visible part of a Remote
|
||||
-- Call Interface compilation unit, for semantic checking purposes only
|
||||
-- (returns false within an instance and within the package body).
|
||||
function In_RCI_Visible_Declarations return Boolean;
|
||||
-- Determines if the visible part of a remote call interface library unit
|
||||
-- is being compiled, for semantic checking purposes (returns False within
|
||||
-- an instance and within the package body).
|
||||
|
||||
function In_RT_Declaration return Boolean;
|
||||
-- Determines if current scope is within the declaration of a Remote Types
|
||||
|
|
@ -544,30 +544,39 @@ package body Sem_Cat is
|
|||
return Is_Pure (Current_Scope);
|
||||
end In_Pure_Unit;
|
||||
|
||||
------------------------
|
||||
-- In_RCI_Declaration --
|
||||
------------------------
|
||||
---------------------------------
|
||||
-- In_RCI_Visible_Declarations --
|
||||
---------------------------------
|
||||
|
||||
function In_RCI_Declaration (N : Node_Id) return Boolean is
|
||||
Unit_Entity : constant Entity_Id := Current_Scope;
|
||||
function In_RCI_Visible_Declarations return Boolean is
|
||||
Unit_Entity : Entity_Id := Current_Scope;
|
||||
Unit_Kind : constant Node_Kind :=
|
||||
Nkind (Unit (Cunit (Current_Sem_Unit)));
|
||||
|
||||
begin
|
||||
-- There are no restrictions on the private part or body
|
||||
-- of an RCI unit.
|
||||
-- There are no restrictions on the private part or body of an RCI unit
|
||||
|
||||
return Is_Remote_Call_Interface (Unit_Entity)
|
||||
if not (Is_Remote_Call_Interface (Unit_Entity)
|
||||
and then Is_Package_Or_Generic_Package (Unit_Entity)
|
||||
and then Unit_Kind /= N_Package_Body
|
||||
and then List_Containing (N) =
|
||||
Visible_Declarations (Package_Specification (Unit_Entity))
|
||||
and then not In_Package_Body (Unit_Entity)
|
||||
and then not In_Instance;
|
||||
and then not In_Instance)
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- What about the case of a nested package in the visible part???
|
||||
-- This case is missed by the List_Containing check above???
|
||||
end In_RCI_Declaration;
|
||||
while Unit_Entity /= Standard_Standard loop
|
||||
if In_Private_Part (Unit_Entity) then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
Unit_Entity := Scope (Unit_Entity);
|
||||
end loop;
|
||||
|
||||
-- Here if in RCI declaration, and not in private part of any open
|
||||
-- scope.
|
||||
|
||||
return True;
|
||||
end In_RCI_Visible_Declarations;
|
||||
|
||||
-----------------------
|
||||
-- In_RT_Declaration --
|
||||
|
|
@ -1371,7 +1380,7 @@ package body Sem_Cat is
|
|||
-- The visible part of an RCI library unit must not contain the
|
||||
-- declaration of a variable (RM E.1.3(9))
|
||||
|
||||
elsif In_RCI_Declaration (N) then
|
||||
elsif In_RCI_Visible_Declarations then
|
||||
Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N);
|
||||
|
||||
-- The visible part of a Shared Passive library unit must not contain
|
||||
|
|
@ -1609,7 +1618,7 @@ package body Sem_Cat is
|
|||
-- 1. from Analyze_Subprogram_Declaration.
|
||||
-- 2. from Validate_Object_Declaration (access to subprogram).
|
||||
|
||||
if not (Comes_From_Source (N) and then In_RCI_Declaration (N)) then
|
||||
if not (Comes_From_Source (N) and then In_RCI_Visible_Declarations) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
|
@ -1652,12 +1661,10 @@ package body Sem_Cat is
|
|||
|
||||
-- Report error only if declaration is in source program
|
||||
|
||||
if Comes_From_Source
|
||||
(Defining_Entity (Specification (N)))
|
||||
then
|
||||
if Comes_From_Source (Id) then
|
||||
Error_Msg_N
|
||||
("subprogram in 'R'C'I unit cannot have access parameter",
|
||||
Error_Node);
|
||||
Error_Node);
|
||||
end if;
|
||||
|
||||
-- For a limited private type parameter, we check only the private
|
||||
|
|
@ -1680,8 +1687,15 @@ package body Sem_Cat is
|
|||
|
||||
Next (Param_Spec);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- No check on return type???
|
||||
if Ekind (Id) = E_Function
|
||||
and then Ekind (Etype (Id)) = E_Anonymous_Access_Type
|
||||
and then Comes_From_Source (Id)
|
||||
then
|
||||
Error_Msg_N
|
||||
("function in 'R'C'I unit cannot have access result",
|
||||
Error_Node);
|
||||
end if;
|
||||
end Validate_RCI_Subprogram_Declaration;
|
||||
|
||||
|
|
@ -1698,8 +1712,8 @@ package body Sem_Cat is
|
|||
-- the given node is N_Access_To_Object_Definition.
|
||||
|
||||
if not Comes_From_Source (T)
|
||||
or else (not In_RCI_Declaration (Parent (T))
|
||||
and then not In_RT_Declaration)
|
||||
or else (not In_RCI_Visible_Declarations
|
||||
and then not In_RT_Declaration)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
|
@ -1721,7 +1735,7 @@ package body Sem_Cat is
|
|||
if Ekind (T) /= E_General_Access_Type
|
||||
or else not Is_Class_Wide_Type (Designated_Type (T))
|
||||
then
|
||||
if In_RCI_Declaration (Parent (T)) then
|
||||
if In_RCI_Visible_Declarations then
|
||||
Error_Msg_N
|
||||
("error in access type in Remote_Call_Interface unit", T);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -1699,15 +1699,26 @@ package body Sem_Ch13 is
|
|||
-- illegal specification of this aspect for a subtype now,
|
||||
-- to prevent malformed rep_item chains.
|
||||
|
||||
if (A_Id = Aspect_Input or else
|
||||
A_Id = Aspect_Output or else
|
||||
A_Id = Aspect_Read or else
|
||||
A_Id = Aspect_Write)
|
||||
and not Is_First_Subtype (E)
|
||||
if A_Id = Aspect_Input or else
|
||||
A_Id = Aspect_Output or else
|
||||
A_Id = Aspect_Read or else
|
||||
A_Id = Aspect_Write
|
||||
then
|
||||
Error_Msg_N
|
||||
("local name must be a first subtype", Aspect);
|
||||
goto Continue;
|
||||
if not Is_First_Subtype (E) then
|
||||
Error_Msg_N
|
||||
("local name must be a first subtype", Aspect);
|
||||
goto Continue;
|
||||
|
||||
-- If stream aspect applies to the class-wide type,
|
||||
-- the generated attribute definition applies to the
|
||||
-- class-wide type as well.
|
||||
|
||||
elsif Class_Present (Aspect) then
|
||||
Ent :=
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => Ent,
|
||||
Attribute_Name => Name_Class);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Construct the attribute definition clause
|
||||
|
|
@ -3556,6 +3567,8 @@ package body Sem_Ch13 is
|
|||
if Base_Type (Typ) = Base_Type (Ent)
|
||||
or else (Is_Class_Wide_Type (Typ)
|
||||
and then Typ = Class_Wide_Type (Base_Type (Ent)))
|
||||
or else (Is_Class_Wide_Type (Ent)
|
||||
and then Ent = Class_Wide_Type (Base_Type (Typ)))
|
||||
then
|
||||
null;
|
||||
else
|
||||
|
|
@ -4794,6 +4807,7 @@ package body Sem_Ch13 is
|
|||
|
||||
when Attribute_Default_Iterator => Default_Iterator : declare
|
||||
Func : Entity_Id;
|
||||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
if not Is_Tagged_Type (U_Ent) then
|
||||
|
|
@ -4813,9 +4827,26 @@ package body Sem_Ch13 is
|
|||
Func := Entity (Expr);
|
||||
end if;
|
||||
|
||||
if No (First_Formal (Func))
|
||||
or else Etype (First_Formal (Func)) /= U_Ent
|
||||
-- The type of the first parameter must be T, T'class, or a
|
||||
-- corresponding access type (5.5.1 (8/3)
|
||||
|
||||
if No (First_Formal (Func)) then
|
||||
Typ := Empty;
|
||||
else
|
||||
Typ := Etype (First_Formal (Func));
|
||||
end if;
|
||||
|
||||
if Typ = U_Ent
|
||||
or else Typ = Class_Wide_Type (U_Ent)
|
||||
or else (Is_Access_Type (Typ)
|
||||
and then Designated_Type (Typ) = U_Ent)
|
||||
or else (Is_Access_Type (Typ)
|
||||
and then Designated_Type (Typ) =
|
||||
Class_Wide_Type (U_Ent))
|
||||
then
|
||||
null;
|
||||
|
||||
else
|
||||
Error_Msg_NE
|
||||
("Default Iterator must be a primitive of&", Func, U_Ent);
|
||||
end if;
|
||||
|
|
@ -4832,9 +4863,8 @@ package body Sem_Ch13 is
|
|||
|
||||
if From_Aspect_Specification (N) then
|
||||
if not Is_Task_Type (U_Ent) then
|
||||
Error_Msg_N ("Dispatching_Domain can only be defined" &
|
||||
"for task",
|
||||
Nam);
|
||||
Error_Msg_N
|
||||
("Dispatching_Domain can only be defined for task", Nam);
|
||||
|
||||
elsif Duplicate_Clause then
|
||||
null;
|
||||
|
|
|
|||
|
|
@ -159,8 +159,64 @@ package body Set_Targ is
|
|||
-- floating-point type, and Precision, Size and Alignment are the precision
|
||||
-- size and alignment in bits.
|
||||
--
|
||||
-- So to summarize, the only types that are actually registered have Digs
|
||||
-- non-zero, Complex zero (false), and Count zero (not a vector).
|
||||
-- The only types that are actually registered have Digs non-zero, Complex
|
||||
-- zero (false), and Count zero (not a vector). The Long_Double_Index
|
||||
-- variable below is updated to indicate the index at which a "long double"
|
||||
-- type can be found if it gets registered at all.
|
||||
|
||||
Long_Double_Index : Integer := -1;
|
||||
-- Once all the back-end types have been registered, the index in
|
||||
-- FPT_Mode_Table at which "long double" can be found, if anywhere. A
|
||||
-- negative value means that no "long double" has been registered. This
|
||||
-- is useful to know whether we have a "long double" available at all and
|
||||
-- get at it's characteristics without having to search the FPT_Mode_Table
|
||||
-- when we need to decide which C type should be used as the basis for
|
||||
-- Long_Long_Float in Ada.
|
||||
|
||||
function FPT_Mode_Index_For (Name : String) return Natural;
|
||||
-- Return the index in FPT_Mode_Table that designates the entry
|
||||
-- corresponding to the C type named Name. Raise Program_Error if
|
||||
-- there is no such entry.
|
||||
|
||||
function FPT_Mode_Index_For (T : S_Float_Types) return Natural;
|
||||
-- Return the index in FPT_Mode_Table that designates the entry for
|
||||
-- a back-end type suitable as a basis to construct the standard Ada
|
||||
-- floating point type identified by T.
|
||||
|
||||
----------------
|
||||
-- C_Type_For --
|
||||
----------------
|
||||
|
||||
function C_Type_For (T : S_Float_Types) return String is
|
||||
|
||||
-- ??? For now, we don't have a good way to tell the widest float
|
||||
-- type with hardware support. Basically, GCC knows the size of that
|
||||
-- type, but on x86-64 there often are two or three 128-bit types,
|
||||
-- one double extended that has 18 decimal digits, a 128-bit quad
|
||||
-- precision type with 33 digits and possibly a 128-bit decimal float
|
||||
-- type with 34 digits. As a workaround, we define Long_Long_Float as
|
||||
-- C's "long double" if that type exists and has at most 18 digits,
|
||||
-- or otherwise the same as Long_Float.
|
||||
|
||||
Max_HW_Digs : constant := 18;
|
||||
-- Maximum hardware digits supported
|
||||
|
||||
begin
|
||||
case T is
|
||||
when S_Short_Float | S_Float =>
|
||||
return "float";
|
||||
when S_Long_Float =>
|
||||
return "double";
|
||||
when S_Long_Long_Float =>
|
||||
if Long_Double_Index >= 0
|
||||
and then FPT_Mode_Table (Long_Double_Index).DIGS <= Max_HW_Digs
|
||||
then
|
||||
return "long double";
|
||||
else
|
||||
return "double";
|
||||
end if;
|
||||
end case;
|
||||
end C_Type_For;
|
||||
|
||||
----------
|
||||
-- Fail --
|
||||
|
|
@ -169,12 +225,33 @@ package body Set_Targ is
|
|||
procedure Fail (E : String) is
|
||||
E_Fatal : constant := 4;
|
||||
-- Code for fatal error
|
||||
|
||||
begin
|
||||
Write_Str (E);
|
||||
Write_Eol;
|
||||
OS_Exit (E_Fatal);
|
||||
end Fail;
|
||||
|
||||
------------------------
|
||||
-- FPT_Mode_Index_For --
|
||||
------------------------
|
||||
|
||||
function FPT_Mode_Index_For (Name : String) return Natural is
|
||||
begin
|
||||
for J in FPT_Mode_Table'First .. Num_FPT_Modes loop
|
||||
if FPT_Mode_Table (J).NAME.all = Name then
|
||||
return J;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
raise Program_Error;
|
||||
end FPT_Mode_Index_For;
|
||||
|
||||
function FPT_Mode_Index_For (T : S_Float_Types) return Natural is
|
||||
begin
|
||||
return FPT_Mode_Index_For (C_Type_For (T));
|
||||
end FPT_Mode_Index_For;
|
||||
|
||||
-------------------------
|
||||
-- Register_Float_Type --
|
||||
-------------------------
|
||||
|
|
@ -281,14 +358,23 @@ package body Set_Targ is
|
|||
-- Acquire entry if non-vector non-complex fpt type (digits non-zero)
|
||||
|
||||
if Digs > 0 and then not Complex and then Count = 0 then
|
||||
Num_FPT_Modes := Num_FPT_Modes + 1;
|
||||
FPT_Mode_Table (Num_FPT_Modes) :=
|
||||
(NAME => new String'(T (1 .. Last)),
|
||||
DIGS => Digs,
|
||||
FLOAT_REP => Float_Rep,
|
||||
PRECISION => Precision,
|
||||
SIZE => Size,
|
||||
ALIGNMENT => Alignment);
|
||||
|
||||
declare
|
||||
This_Name : constant String := T (1 .. Last);
|
||||
begin
|
||||
Num_FPT_Modes := Num_FPT_Modes + 1;
|
||||
FPT_Mode_Table (Num_FPT_Modes) :=
|
||||
(NAME => new String'(This_Name),
|
||||
DIGS => Digs,
|
||||
FLOAT_REP => Float_Rep,
|
||||
PRECISION => Precision,
|
||||
SIZE => Size,
|
||||
ALIGNMENT => Alignment);
|
||||
|
||||
if Long_Double_Index < 0 and then This_Name = "long double" then
|
||||
Long_Double_Index := Num_FPT_Modes;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end Register_Float_Type;
|
||||
|
||||
|
|
@ -801,6 +887,13 @@ begin
|
|||
end loop;
|
||||
end;
|
||||
|
||||
-- Register floating-point types from the back end. We do this
|
||||
-- unconditionally so C_Type_For may be called regardless of -gnateT, for
|
||||
-- which cstand has a use, and early so we can use FPT_Mode_Table below to
|
||||
-- compute some FP attributes.
|
||||
|
||||
Register_Back_End_Types (Register_Float_Type'Access);
|
||||
|
||||
-- Case of reading the target dependent values from file
|
||||
|
||||
-- This is bit more complex than might be expected, because it has to be
|
||||
|
|
@ -832,11 +925,8 @@ begin
|
|||
Char_Size := Get_Char_Size;
|
||||
Double_Float_Alignment := Get_Double_Float_Alignment;
|
||||
Double_Scalar_Alignment := Get_Double_Scalar_Alignment;
|
||||
Double_Size := Get_Double_Size;
|
||||
Float_Size := Get_Float_Size;
|
||||
Float_Words_BE := Get_Float_Words_BE;
|
||||
Int_Size := Get_Int_Size;
|
||||
Long_Double_Size := Get_Long_Double_Size;
|
||||
Long_Long_Size := Get_Long_Long_Size;
|
||||
Long_Size := Get_Long_Size;
|
||||
Maximum_Alignment := Get_Maximum_Alignment;
|
||||
|
|
@ -849,9 +939,29 @@ begin
|
|||
Wchar_T_Size := Get_Wchar_T_Size;
|
||||
Words_BE := Get_Words_BE;
|
||||
|
||||
-- Register floating-point types from the back end
|
||||
-- Compute the sizes of floating point types
|
||||
|
||||
declare
|
||||
T : FPT_Mode_Entry renames
|
||||
FPT_Mode_Table (FPT_Mode_Index_For (S_Float));
|
||||
begin
|
||||
Float_Size := Int (T.SIZE);
|
||||
end;
|
||||
|
||||
declare
|
||||
T : FPT_Mode_Entry renames
|
||||
FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Float));
|
||||
begin
|
||||
Double_Size := Int (T.SIZE);
|
||||
end;
|
||||
|
||||
declare
|
||||
T : FPT_Mode_Entry renames
|
||||
FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Long_Float));
|
||||
begin
|
||||
Long_Double_Size := Int (T.SIZE);
|
||||
end;
|
||||
|
||||
Register_Back_End_Types (Register_Float_Type'Access);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@
|
|||
-- size of wchar_t, since this corresponds to expected Ada usage.
|
||||
|
||||
with Einfo; use Einfo;
|
||||
with Stand; use Stand;
|
||||
with Types; use Types;
|
||||
|
||||
package Set_Targ is
|
||||
|
|
@ -107,6 +108,15 @@ package Set_Targ is
|
|||
-- Subprograms --
|
||||
-----------------
|
||||
|
||||
subtype S_Float_Types is
|
||||
Standard_Entity_Type range S_Short_Float .. S_Long_Long_Float;
|
||||
|
||||
function C_Type_For (T : S_Float_Types) return String;
|
||||
-- Return the name of a C type supported by the back-end and suitable as
|
||||
-- a basis to construct the standard Ada floating point type identified by
|
||||
-- T. This is used as a common ground to feed both ttypes values and the
|
||||
-- GNAT tree nodes for the standard floating point types.
|
||||
|
||||
procedure Write_Target_Dependent_Values;
|
||||
-- This routine writes the file target.atp in the current directory with
|
||||
-- the values of the global target parameters as listed above, and as set
|
||||
|
|
|
|||
Loading…
Reference in New Issue