OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2012-10-29  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb: Minor reformatting.

2012-10-29  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Minor rewording.

2012-10-29  Javier Miranda  <miranda@adacore.com>

	* exp_disp.ads (Is_Expanded_Dispatching_Call): New subprogram.
	* exp_disp.adb (Expand_Dispatching_Call): No action needed if the
	call has been already expanded.
	(Is_Expanded_Dispatching_Call): New subprogram.
	* sem_disp.adb (Propagate_Tag): No action needed if the call
	has been already expanded.

2012-10-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch9.adb (Create_Index_And_Data): Remove local
	variable Index_Typ and its uses. The type of the index is now
	System.Tasking.Entry_Index. Update all related comments.
	* rtsfind.ads: Add RE_Entry_Index in tables RE_Id and RE_Unit_Table.
	* s-taskin.adb (Number_Of_Entries): The return type is now Entry_Index.
	* s-taskin.ads: The index type of Task_Entry_Names_Array is now
	Entry_Index.
	(Number_Of_Entries): The return type is now Entry_Index.
	* s-tpoben.adb (Number_Of_Entries): The return type is now Entry_Index.
	* s-tpoben.ads: The index type of Protected_Entry_Names_Array
	is now Entry_Index.
	(Number_Of_Entries): The return type is now Entry_Index.

2012-10-29  Pascal Obry  <obry@adacore.com>

	* gnat_ugn.texi: Add note about SEH setup on x86-windows.

2012-10-29  Eric Botcazou  <ebotcazou@adacore.com>

	* s-bignum.adb (Allocate_Bignum): Use the exact layout of
	Bignum_Data for the overlay.

From-SVN: r192936
This commit is contained in:
Arnaud Charlet 2012-10-29 12:32:18 +01:00
parent 2d7b3fa49d
commit 7af1cf8342
14 changed files with 154 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/ChangeLog
View File

@ -1,3 +1,44 @@
2012-10-29 Robert Dewar <dewar@adacore.com>
* sem_prag.adb: Minor reformatting.
2012-10-29 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Minor rewording.
2012-10-29 Javier Miranda <miranda@adacore.com>
* exp_disp.ads (Is_Expanded_Dispatching_Call): New subprogram.
* exp_disp.adb (Expand_Dispatching_Call): No action needed if the
call has been already expanded.
(Is_Expanded_Dispatching_Call): New subprogram.
* sem_disp.adb (Propagate_Tag): No action needed if the call
has been already expanded.
2012-10-29 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb (Create_Index_And_Data): Remove local
variable Index_Typ and its uses. The type of the index is now
System.Tasking.Entry_Index. Update all related comments.
* rtsfind.ads: Add RE_Entry_Index in tables RE_Id and RE_Unit_Table.
* s-taskin.adb (Number_Of_Entries): The return type is now Entry_Index.
* s-taskin.ads: The index type of Task_Entry_Names_Array is now
Entry_Index.
(Number_Of_Entries): The return type is now Entry_Index.
* s-tpoben.adb (Number_Of_Entries): The return type is now Entry_Index.
* s-tpoben.ads: The index type of Protected_Entry_Names_Array
is now Entry_Index.
(Number_Of_Entries): The return type is now Entry_Index.
2012-10-29 Pascal Obry <obry@adacore.com>
* gnat_ugn.texi: Add note about SEH setup on x86-windows.
2012-10-29 Eric Botcazou <ebotcazou@adacore.com>
* s-bignum.adb (Allocate_Bignum): Use the exact layout of
Bignum_Data for the overlay.
2012-10-29 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi, sem_prag.adb, sem_util.adb, sem_util.ads,

25
gcc/ada/exp_ch9.adb
View File

@ -1460,25 +1460,22 @@ package body Exp_Ch9 is
begin
if No (Index) and then No (Data) then
declare
Count : RE_Id;
Data_Typ : RE_Id;
Index_Typ : RE_Id;
Size : Entity_Id;
Count : RE_Id;
Data_Typ : RE_Id;
Size : Entity_Id;
begin
if Is_Protected_Type (Typ) then
Count := RO_PE_Number_Of_Entries;
Data_Typ := RE_Protected_Entry_Names_Array;
Index_Typ := RE_Protected_Entry_Index;
Count := RO_PE_Number_Of_Entries;
Data_Typ := RE_Protected_Entry_Names_Array;
else
Count := RO_ST_Number_Of_Entries;
Data_Typ := RE_Task_Entry_Names_Array;
Index_Typ := RE_Task_Entry_Index;
Count := RO_ST_Number_Of_Entries;
Data_Typ := RE_Task_Entry_Names_Array;
end if;
-- Step 1: Generate the declaration of the index variable:
-- Index : <Index_Typ> := 1;
-- Index : Entry_Index := 1;
Index := Make_Temporary (Loc, 'I');
@ -1486,13 +1483,13 @@ package body Exp_Ch9 is
Make_Object_Declaration (Loc,
Defining_Identifier => Index,
Object_Definition =>
New_Reference_To (RTE (Index_Typ), Loc),
New_Reference_To (RTE (RE_Entry_Index), Loc),
Expression => Make_Integer_Literal (Loc, 1)));
-- Step 2: Generate the declaration of an array to house all
-- names:
-- Size : constant <Index_Typ> := <Count> (Obj_Ref);
-- Size : constant Entry_Index := <Count> (Obj_Ref);
-- Data : aliased <Data_Typ> := (1 .. Size => null);
Size := Make_Temporary (Loc, 'S');
@ -1502,7 +1499,7 @@ package body Exp_Ch9 is
Defining_Identifier => Size,
Constant_Present => True,
Object_Definition =>
New_Reference_To (RTE (Index_Typ), Loc),
New_Reference_To (RTE (RE_Entry_Index), Loc),
Expression =>
Make_Function_Call (Loc,
Name =>

15
gcc/ada/exp_disp.adb
View File

@ -703,6 +703,10 @@ package body Exp_Disp is
-- previously notified the violation of this restriction.
or else Restriction_Active (No_Dispatching_Calls)
-- No action needed if the dispatching call has been already expanded
or else Is_Expanded_Dispatching_Call (Name (Call_Node))
then
return;
end if;
@ -1975,6 +1979,17 @@ package body Exp_Disp is
and then not Restriction_Active (No_Dispatching_Calls);
end Has_DT;
----------------------------------
-- Is_Expanded_Dispatching_Call --
----------------------------------
function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean is
begin
return Nkind (N) in N_Subprogram_Call
and then Nkind (Name (N)) = N_Explicit_Dereference
and then Is_Dispatch_Table_Entity (Etype (Name (N)));
end Is_Expanded_Dispatching_Call;
-----------------------------------------
-- Is_Predefined_Dispatching_Operation --
-----------------------------------------

5
gcc/ada/exp_disp.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -245,6 +245,9 @@ package Exp_Disp is
function Has_CPP_Constructors (Typ : Entity_Id) return Boolean;
-- Returns true if the type has CPP constructors
function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean;
-- Returns true if N is the expanded code of a dispatching call
function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
-- Ada 2005 (AI-251): Determines if E is a predefined primitive operation

7
gcc/ada/gnat_rm.texi
View File

@ -1323,12 +1323,15 @@ pragma Attribute_Definition
@end smallexample
@noindent
If Attribute is a known attribute name, this pragma is equivalent to
If @code{Attribute} is a known attribute name, this pragma is equivalent to
the attribute definition clause:
@smallexample @c ada
for Entity'Attribute use Expression;
@end smallexample
else the pragma is ignored, and a warning is emitted. This allows source
If @code{Attribute} is not a recognized attribute name, the pragma is
ignored, and a warning is emitted. This allows source
code to be written that takes advantage of some new attribute, while remaining
compilable with earlier compilers.

32
gcc/ada/gnat_ugn.texi
View File

@ -28346,6 +28346,38 @@ other part of your application. In this case, use GNAT to build the DLL
or whatever environment to build your executable.
@end enumerate
In addition to the description about C main in
@pxref{Mixed Language Programming} section, if the C main uses a
stand-alone library it is required on x86-windows to
setup the SEH context. For this the C main must looks like this:
@smallexample
/* main.c */
extern void adainit (void);
extern void adafinal (void);
extern void __gnat_initialize(void*);
extern void call_to_ada (void);
int main (int argc, char *argv[])
@{
int SEH [2];
/* Initialize the SEH context */
__gnat_initialize (&SEH);
adainit();
/* Then call Ada services in the stand-alone library */
call_to_ada();
adafinal();
@}
@end smallexample
Note that this is not needed on x86_64-windows where the Windows
native SEH support is used.
@node Windows Calling Conventions
@section Windows Calling Conventions
@findex Stdcall

2
gcc/ada/rtsfind.ads
View File

@ -1531,6 +1531,7 @@ package Rtsfind is
RE_Simple_Mode, -- System.Tasking
RE_Terminate_Mode, -- System.Tasking
RE_Delay_Mode, -- System.Tasking
RE_Entry_Index, -- System.Tasking
RE_Task_Entry_Index, -- System.Tasking
RE_Self, -- System.Tasking
@ -2782,6 +2783,7 @@ package Rtsfind is
RE_Simple_Mode => System_Tasking,
RE_Terminate_Mode => System_Tasking,
RE_Delay_Mode => System_Tasking,
RE_Entry_Index => System_Tasking,
RE_Task_Entry_Index => System_Tasking,
RE_Self => System_Tasking,

23
gcc/ada/s-bignum.adb
View File

@ -233,14 +233,27 @@ package body System.Bignums is
pragma Import (Ada, BD);
-- Expose a writable view of discriminant BD.Len so that we can
-- initialize it.
-- initialize it. We need to use the exact layout of the record
-- for the overlay to shield ourselves from endianness issues.
BL : Length;
for BL'Address use BD.Len'Address;
pragma Import (Ada, BL);
type Bignum_Data_Header is record
Len : Length;
Neg : Boolean;
end record;
for Bignum_Data_Header use record
Len at 0 range 0 .. 23;
Neg at 3 range 0 .. 7;
end record;
BDH : Bignum_Data_Header;
for BDH'Address use BD'Address;
pragma Import (Ada, BDH);
pragma Assert (BDH.Len'Size = BD.Len'Size);
begin
BL := Len;
BDH.Len := Len;
return B;
end;
end if;

4
gcc/ada/s-taskin.adb
View File

@ -59,9 +59,9 @@ package body System.Tasking is
-- Number_Of_Entries --
-----------------------
function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index is
function Number_Of_Entries (Self_Id : Task_Id) return Entry_Index is
begin
return Self_Id.Entry_Num;
return Entry_Index (Self_Id.Entry_Num);
end Number_Of_Entries;
----------

4
gcc/ada/s-taskin.ads
View File

@ -253,7 +253,7 @@ package System.Tasking is
type String_Access is access all String;
type Task_Entry_Names_Array is
array (Task_Entry_Index range <>) of String_Access;
array (Entry_Index range <>) of String_Access;
type Task_Entry_Names_Access is access all Task_Entry_Names_Array;
@ -1203,7 +1203,7 @@ private
-- registered for removal (Expunge_Unactivated_Tasks). The "limited" forces
-- Activation_Chain to be a by-reference type; see RM-6.2(4).
function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index;
function Number_Of_Entries (Self_Id : Task_Id) return Entry_Index;
-- Given a task, return the number of entries it contains
procedure Set_Entry_Names

4
gcc/ada/s-tpoben.adb
View File

@ -359,10 +359,10 @@ package body System.Tasking.Protected_Objects.Entries is
-----------------------
function Number_Of_Entries
(Object : Protection_Entries_Access) return Protected_Entry_Index
(Object : Protection_Entries_Access) return Entry_Index
is
begin
return Object.Num_Entries;
return Entry_Index (Object.Num_Entries);
end Number_Of_Entries;
-----------------

10
gcc/ada/s-tpoben.ads
View File

@ -66,10 +66,14 @@ package System.Tasking.Protected_Objects.Entries is
type Protected_Entry_Queue_Array is
array (Protected_Entry_Index range <>) of Entry_Queue;
-- The following declarations define an array that contains the string
-- names of entries and entry family members, together with an associated
-- access type.
type Protected_Entry_Names_Array is
array (Protected_Entry_Index range <>) of String_Access;
array (Entry_Index range <>) of String_Access;
type Protected_Entry_Names_Access is access all Protected_Entry_Names_Array;
-- Contains string name of entries and entry family members
-- The following type contains the GNARL state of a protected object.
-- The application-defined portion of the state (i.e. private objects)
@ -205,7 +209,7 @@ package System.Tasking.Protected_Objects.Entries is
-- read and write locks.
function Number_Of_Entries
(Object : Protection_Entries_Access) return Protected_Entry_Index;
(Object : Protection_Entries_Access) return Entry_Index;
-- Return the number of entries of a protected object
procedure Set_Ceiling

6
gcc/ada/sem_disp.adb
View File

@ -2382,6 +2382,12 @@ package body Sem_Disp is
Call_Node := Expression (Actual);
end if;
-- No action needed if the call has been already expanded
if Is_Expanded_Dispatching_Call (Call_Node) then
return;
end if;
-- Do not set the Controlling_Argument if already set. This happens in
-- the special case of _Input (see Exp_Attr, case Input).

8
gcc/ada/sem_prag.adb
View File

@ -6930,7 +6930,7 @@ package body Sem_Prag is
when Pragma_Attribute_Definition => Attribute_Definition : declare
Attribute_Designator : constant Node_Id := Get_Pragma_Arg (Arg1);
Aname : Name_Id;
Aname : Name_Id;
begin
GNAT_Pragma;
@ -6946,12 +6946,18 @@ package body Sem_Prag is
Check_Arg_Is_Local_Name (Arg2);
-- If the attribute is not recognized, then issue a warning (not
-- an error), and ignore the pragma.
Aname := Chars (Attribute_Designator);
if not Is_Attribute_Name (Aname) then
Bad_Attribute (Attribute_Designator, Aname, Warn => True);
return;
end if;
-- Otherwise, rewrite the pragma as an attribute definition clause
Rewrite (N,
Make_Attribute_Definition_Clause (Loc,
Name => Get_Pragma_Arg (Arg2),