From: charlet Date: Mon, 29 Oct 2012 11:32:18 +0000 (+0000) Subject: 2012-10-29 Robert Dewar X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=687b56873a189a7f8a7dc95b95a5315a9672eaed;p=thirdparty%2Fgcc.git 2012-10-29 Robert Dewar * sem_prag.adb: Minor reformatting. 2012-10-29 Robert Dewar * gnat_rm.texi: Minor rewording. 2012-10-29 Javier Miranda * 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 * 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 * gnat_ugn.texi: Add note about SEH setup on x86-windows. 2012-10-29 Eric Botcazou * s-bignum.adb (Allocate_Bignum): Use the exact layout of Bignum_Data for the overlay. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@192936 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ff6e85c3e814..96f81e75b870 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2012-10-29 Robert Dewar + + * sem_prag.adb: Minor reformatting. + +2012-10-29 Robert Dewar + + * gnat_rm.texi: Minor rewording. + +2012-10-29 Javier Miranda + + * 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 + + * 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 + + * gnat_ugn.texi: Add note about SEH setup on x86-windows. + +2012-10-29 Eric Botcazou + + * s-bignum.adb (Allocate_Bignum): Use the exact layout of + Bignum_Data for the overlay. + 2012-10-29 Thomas Quinot * gnat_rm.texi, sem_prag.adb, sem_util.adb, sem_util.ads, diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 77397c659278..82a7a309c723 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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 : := 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 := (Obj_Ref); + -- Size : constant Entry_Index := (Obj_Ref); -- Data : aliased := (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 => diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 9b5cb5716ea6..c3cd9c037b26 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -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 -- ----------------------------------------- diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index 9943bda0f63a..f95fba5adfe8 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -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 diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 098978c7c3c2..c6e092c81ca5 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b1e723920c35..53df9a19984c 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -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 diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 63ff87cb33ac..5f9c9934ca4c 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -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, diff --git a/gcc/ada/s-bignum.adb b/gcc/ada/s-bignum.adb index 955df4277c2a..70486f2ddea1 100644 --- a/gcc/ada/s-bignum.adb +++ b/gcc/ada/s-bignum.adb @@ -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; diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 00c54ed9e471..5baf12876554 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -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; ---------- diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index 03533a8bf3ac..26cfabb8aee5 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -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 diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb index f535a067bf76..3249122b386a 100644 --- a/gcc/ada/s-tpoben.adb +++ b/gcc/ada/s-tpoben.adb @@ -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; ----------------- diff --git a/gcc/ada/s-tpoben.ads b/gcc/ada/s-tpoben.ads index b41f1caeb949..8a91bbb03e1e 100644 --- a/gcc/ada/s-tpoben.ads +++ b/gcc/ada/s-tpoben.ads @@ -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 diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 05eb5022e912..509293655967 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -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). diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2957c856eac2..369376ad5553 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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),