Commit 66bdcfd6 by Arnaud Charlet

[multiple changes]

2009-11-30  Vasiliy Fofanov  <fofanov@adacore.com>

	* vms_data.ads: Add new VMS qualifiers,
	REVERSE_BIT_ORDER/NOREVERSE_BIT_ORDER, to support warnings on bit order
	effects.

2009-11-30  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb, exp_ch9.ads, sem_util.ads: Minor reformatting.

2009-11-30  Gary Dismukes  <dismukes@adacore.com>

	* sem_prag.adb: Fix spelling error.

From-SVN: r154829
parent 47bfea3a
2009-11-30 Vasiliy Fofanov <fofanov@adacore.com>
* vms_data.ads: Add new VMS qualifiers,
REVERSE_BIT_ORDER/NOREVERSE_BIT_ORDER, to support warnings on bit order
effects.
2009-11-30 Thomas Quinot <quinot@adacore.com>
* exp_ch9.adb, exp_ch9.ads, sem_util.ads: Minor reformatting.
2009-11-30 Gary Dismukes <dismukes@adacore.com>
* sem_prag.adb: Fix spelling error.
2009-11-30 Ed Schonberg <schonberg@adacore.com> 2009-11-30 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.ads (Build_Private_Protected_Declaration): For a protected * exp_ch9.ads (Build_Private_Protected_Declaration): For a protected
......
...@@ -2555,8 +2555,8 @@ package body Exp_Ch9 is ...@@ -2555,8 +2555,8 @@ package body Exp_Ch9 is
-- Build_Private_Protected_Declaration -- -- Build_Private_Protected_Declaration --
----------------------------------------- -----------------------------------------
function Build_Private_Protected_Declaration (N : Node_Id) function Build_Private_Protected_Declaration
return Entity_Id (N : Node_Id) return Entity_Id
is is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Body_Id : constant Entity_Id := Defining_Entity (N); Body_Id : constant Entity_Id := Defining_Entity (N);
...@@ -2569,13 +2569,11 @@ package body Exp_Ch9 is ...@@ -2569,13 +2569,11 @@ package body Exp_Ch9 is
begin begin
Formal := First_Formal (Body_Id); Formal := First_Formal (Body_Id);
-- The protected operation always has at least one formal, namely -- The protected operation always has at least one formal, namely the
-- the object itself, but it is only placed in the parameter list -- object itself, but it is only placed in the parameter list if
-- if expansion is enabled. -- expansion is enabled.
if Present (Formal) if Present (Formal) or else Expander_Active then
or else Expander_Active
then
Plist := Copy_Parameter_List (Body_Id); Plist := Copy_Parameter_List (Body_Id);
else else
Plist := No_List; Plist := No_List;
...@@ -2587,28 +2585,28 @@ package body Exp_Ch9 is ...@@ -2587,28 +2585,28 @@ package body Exp_Ch9 is
Defining_Unit_Name => Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id), Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)), Chars => Chars (Body_Id)),
Parameter_Specifications => Plist); Parameter_Specifications =>
Plist);
else else
New_Spec := New_Spec :=
Make_Function_Specification (Loc, Make_Function_Specification (Loc,
Defining_Unit_Name => Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id), Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)), Chars => Chars (Body_Id)),
Parameter_Specifications => Plist, Parameter_Specifications =>
Plist,
Result_Definition => Result_Definition =>
New_Occurrence_Of (Etype (Body_Id), Loc)); New_Occurrence_Of (Etype (Body_Id), Loc));
end if; end if;
Decl := Decl := Make_Subprogram_Declaration (Loc, Specification => New_Spec);
Make_Subprogram_Declaration (Loc,
Specification => New_Spec);
Insert_Before (N, Decl); Insert_Before (N, Decl);
Spec_Id := Defining_Unit_Name (New_Spec); Spec_Id := Defining_Unit_Name (New_Spec);
-- Indicate that the entity comes from source, to ensure that -- Indicate that the entity comes from source, to ensure that cross-
-- cross-reference information is properly generated. The body -- reference information is properly generated. The body itself is
-- itself is rewritten during expansion, and the body entity will -- rewritten during expansion, and the body entity will not appear in
-- not appear in calls to the operation. -- calls to the operation.
Set_Comes_From_Source (Spec_Id, True); Set_Comes_From_Source (Spec_Id, True);
Analyze (Decl); Analyze (Decl);
...@@ -7424,16 +7422,16 @@ package body Exp_Ch9 is ...@@ -7424,16 +7422,16 @@ package body Exp_Ch9 is
Current_Node := New_Op_Body; Current_Node := New_Op_Body;
-- Generate an overriding primitive operation body for -- Generate an overriding primitive operation body for
-- this subprogram if the protected type implements -- this subprogram if the protected type implements an
-- an interface. -- interface.
if Ada_Version >= Ada_05 if Ada_Version >= Ada_05
and then Present (Interfaces ( and then
Corresponding_Record_Type (Pid))) Present (Interfaces (Corresponding_Record_Type (Pid)))
then then
Disp_Op_Body := Disp_Op_Body :=
Build_Dispatching_Subprogram_Body ( Build_Dispatching_Subprogram_Body
Op_Body, Pid, New_Op_Body); (Op_Body, Pid, New_Op_Body);
Insert_After (Current_Node, Disp_Op_Body); Insert_After (Current_Node, Disp_Op_Body);
Analyze (Disp_Op_Body); Analyze (Disp_Op_Body);
...@@ -7494,8 +7492,8 @@ package body Exp_Ch9 is ...@@ -7494,8 +7492,8 @@ package body Exp_Ch9 is
end loop; end loop;
-- Finally, create the body of the function that maps an entry index -- Finally, create the body of the function that maps an entry index
-- into the corresponding body index, except when there is no entry, -- into the corresponding body index, except when there is no entry, or
-- or in a ravenscar-like profile. -- in a Ravenscar-like profile.
if Corresponding_Runtime_Package (Pid) = if Corresponding_Runtime_Package (Pid) =
System_Tasking_Protected_Objects_Entries System_Tasking_Protected_Objects_Entries
......
...@@ -86,7 +86,7 @@ package Exp_Ch9 is ...@@ -86,7 +86,7 @@ package Exp_Ch9 is
-- body must be expanded separately to create a subprogram declaration -- body must be expanded separately to create a subprogram declaration
-- for it, in order to resolve internal calls to it from other protected -- for it, in order to resolve internal calls to it from other protected
-- operations. It would seem that no locking version of the operation is -- operations. It would seem that no locking version of the operation is
-- needed, but in fact, in Ada2005 the subprogram may be used in a call- -- needed, but in fact, in Ada 2005 the subprogram may be used in a call-
-- back, and therefore a protected version of the operation must be -- back, and therefore a protected version of the operation must be
-- generated as well. -- generated as well.
...@@ -105,28 +105,28 @@ package Exp_Ch9 is ...@@ -105,28 +105,28 @@ package Exp_Ch9 is
Name : Node_Id; Name : Node_Id;
Rec : Node_Id; Rec : Node_Id;
External : Boolean := True); External : Boolean := True);
-- The node N is a subprogram or entry call to a protected subprogram. -- The node N is a subprogram or entry call to a protected subprogram. This
-- This procedure rewrites this call with the appropriate expansion. -- procedure rewrites this call with the appropriate expansion. Name is the
-- Name is the subprogram, and Rec is the record corresponding to the -- subprogram, and Rec is the record corresponding to the protected object.
-- protected object. External is False if the call is to another -- External is False if the call is to another protected subprogram within
-- protected subprogram within the same object. -- the same object.
procedure Build_Task_Activation_Call (N : Node_Id); procedure Build_Task_Activation_Call (N : Node_Id);
-- This procedure is called for constructs that can be task activators -- This procedure is called for constructs that can be task activators,
-- i.e. task bodies, subprogram bodies, package bodies and blocks. If -- i.e. task bodies, subprogram bodies, package bodies and blocks. If the
-- the construct is a task activator (as indicated by the non-empty -- construct is a task activator (as indicated by the non-empty setting of
-- setting of Activation_Chain_Entity, either in the construct, or, in -- Activation_Chain_Entity, either in the construct, or, in the case of a
-- the case of a package body, in its associated package spec), then -- package body, in its associated package spec), then a call to
-- a call to Activate_Tasks with this entity as the single parameter -- Activate_Tasks with this entity as the single parameter is inserted at
-- is inserted at the start of the statements of the activator. -- the start of the statements of the activator.
procedure Build_Task_Allocate_Block procedure Build_Task_Allocate_Block
(Actions : List_Id; (Actions : List_Id;
N : Node_Id; N : Node_Id;
Args : List_Id); Args : List_Id);
-- This routine is used in the case of allocators where the designated -- This routine is used in the case of allocators where the designated type
-- type is a task or contains tasks. In this case, the normal initialize -- is a task or contains tasks. In this case, the normal initialize call
-- call is replaced by: -- is replaced by:
-- --
-- blockname : label; -- blockname : label;
-- blockname : declare -- blockname : declare
...@@ -146,10 +146,10 @@ package Exp_Ch9 is ...@@ -146,10 +146,10 @@ package Exp_Ch9 is
-- --
-- to get the task or tasks created and initialized. The expunge call -- to get the task or tasks created and initialized. The expunge call
-- ensures that any tasks that get created but not activated due to an -- ensures that any tasks that get created but not activated due to an
-- exception are properly expunged (it has no effect in the normal case) -- exception are properly expunged (it has no effect in the normal case).
-- The argument N is the allocator, and Args is the list of arguments -- The argument N is the allocator, and Args is the list of arguments for
-- for the initialization call, constructed by the caller, which uses -- the initialization call, constructed by the caller, which uses the
-- the Master_Id of the access type as the _Master parameter, and _Chain -- Master_Id of the access type as the _Master parameter, and _Chain
-- (defined above) as the _Chain parameter. -- (defined above) as the _Chain parameter.
procedure Build_Task_Allocate_Block_With_Init_Stmts procedure Build_Task_Allocate_Block_With_Init_Stmts
...@@ -199,28 +199,28 @@ package Exp_Ch9 is ...@@ -199,28 +199,28 @@ package Exp_Ch9 is
Index : Node_Id; Index : Node_Id;
Ttyp : Entity_Id) Ttyp : Entity_Id)
return Node_Id; return Node_Id;
-- Returns an expression to compute a task entry index given the name -- Returns an expression to compute a task entry index given the name of
-- of the entry or entry family. For the case of a task entry family, -- the entry or entry family. For the case of a task entry family, the
-- the Index parameter contains the expression for the subscript. -- Index parameter contains the expression for the subscript. Ttyp is the
-- Ttyp is the task type. -- task type.
procedure Establish_Task_Master (N : Node_Id); procedure Establish_Task_Master (N : Node_Id);
-- Given a subprogram body, or a block statement, or a task body, this -- Given a subprogram body, or a block statement, or a task body, this
-- procedure makes the necessary transformations required of a task -- procedure makes the necessary transformations required of a task master
-- master (add Enter_Master call at start, and establish a cleanup -- (add Enter_Master call at start, and establish a cleanup routine to make
-- routine to make sure Complete_Master is called on exit). -- sure Complete_Master is called on exit).
procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id); procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id);
-- Build Equivalent_Type for an Access_To_Protected_Subprogram. -- Build Equivalent_Type for an Access_To_Protected_Subprogram.
-- Equivalent_Type is a record type with two components: a pointer -- Equivalent_Type is a record type with two components: a pointer to the
-- to the protected object, and a pointer to the operation itself. -- protected object, and a pointer to the operation itself.
procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id); procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id);
-- Expand declarations required for accept statement. See bodies of -- Expand declarations required for accept statement. See bodies of both
-- both Expand_Accept_Declarations and Expand_N_Accept_Statement for -- Expand_Accept_Declarations and Expand_N_Accept_Statement for full
-- full details of the nature and use of these declarations, which -- details of the nature and use of these declarations, which are inserted
-- are inserted immediately before the accept node N. The second -- immediately before the accept node N. The second argument is the entity
-- argument is the entity for the corresponding entry. -- for the corresponding entry.
procedure Expand_Entry_Barrier (N : Node_Id; Ent : Entity_Id); procedure Expand_Entry_Barrier (N : Node_Id; Ent : Entity_Id);
-- Expand the entry barrier into a function. This is called directly -- Expand the entry barrier into a function. This is called directly
......
...@@ -1155,7 +1155,7 @@ package body Sem_Prag is ...@@ -1155,7 +1155,7 @@ package body Sem_Prag is
begin begin
-- We allow duplicated export names in CIL, as they are always -- We allow duplicated export names in CIL, as they are always
-- enclosed in a namespace that differenciates them, and overloaded -- enclosed in a namespace that differentiates them, and overloaded
-- entities are supported by the VM. -- entities are supported by the VM.
if VM_Target = CLI_Target then if VM_Target = CLI_Target then
......
...@@ -210,10 +210,10 @@ package Sem_Util is ...@@ -210,10 +210,10 @@ package Sem_Util is
-- of Old is set and Old has no yet been Frozen (i.e. Is_Frozen is false); -- of Old is set and Old has no yet been Frozen (i.e. Is_Frozen is false);
function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id; function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
-- Utility to create a parameter profile for a new subprogram spec, -- Utility to create a parameter profile for a new subprogram spec, when
-- when the subprogram has a body that acts as spec. This is done for -- the subprogram has a body that acts as spec. This is done for some cases
-- some cases of inlining, and for private protected ops. Also used -- of inlining, and for private protected ops. Also used to create bodies
-- to create bodies for stubbed subprograms. -- for stubbed subprograms.
function Current_Entity (N : Node_Id) return Entity_Id; function Current_Entity (N : Node_Id) return Entity_Id;
-- Find the currently visible definition for a given identifier, that is to -- Find the currently visible definition for a given identifier, that is to
...@@ -230,9 +230,9 @@ package Sem_Util is ...@@ -230,9 +230,9 @@ package Sem_Util is
function Current_Subprogram return Entity_Id; function Current_Subprogram return Entity_Id;
-- Returns current enclosing subprogram. If Current_Scope is a subprogram, -- Returns current enclosing subprogram. If Current_Scope is a subprogram,
-- then that is what is returned, otherwise the Enclosing_Subprogram of -- then that is what is returned, otherwise the Enclosing_Subprogram of the
-- the Current_Scope is returned. The returned value is Empty if this -- Current_Scope is returned. The returned value is Empty if this is called
-- is called from a library package which is not within any subprogram. -- from a library package which is not within any subprogram.
function Defining_Entity (N : Node_Id) return Entity_Id; function Defining_Entity (N : Node_Id) return Entity_Id;
-- Given a declaration N, returns the associated defining entity. If -- Given a declaration N, returns the associated defining entity. If
......
...@@ -2983,6 +2983,10 @@ package VMS_Data is ...@@ -2983,6 +2983,10 @@ package VMS_Data is
"-gnatwv " & "-gnatwv " &
"NOVARIABLES_UNINITIALIZED " & "NOVARIABLES_UNINITIALIZED " &
"-gnatwV " & "-gnatwV " &
"REVERSE_BIT_ORDER " &
"-gnatw.v " &
"NOREVERSE_BIT_ORDER " &
"-gnatw.V " &
"LOWBOUND_ASSUMED " & "LOWBOUND_ASSUMED " &
"-gnatww " & "-gnatww " &
"NOLOWBOUND_ASSUMED " & "NOLOWBOUND_ASSUMED " &
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment