+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,
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');
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');
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 =>
-- 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;
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 --
-----------------------------------------
-- --
-- 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- --
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
@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.
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
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
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,
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;
-- 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;
----------
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;
-- 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
-----------------------
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;
-----------------
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)
-- 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
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).
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;
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),
projects / platform / upstream / gcc.git / commitdiff