[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
This commit is contained in:
Arnaud Charlet 2009-11-30 17:31:31 +01:00
parent 47bfea3ae8
commit 66bdcfd655
6 changed files with 86 additions and 70 deletions

View File

@ -1,3 +1,17 @@
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>
* exp_ch9.ads (Build_Private_Protected_Declaration): For a protected

View File

@ -2555,8 +2555,8 @@ package body Exp_Ch9 is
-- Build_Private_Protected_Declaration --
-----------------------------------------
function Build_Private_Protected_Declaration (N : Node_Id)
return Entity_Id
function Build_Private_Protected_Declaration
(N : Node_Id) return Entity_Id
is
Loc : constant Source_Ptr := Sloc (N);
Body_Id : constant Entity_Id := Defining_Entity (N);
@ -2569,13 +2569,11 @@ package body Exp_Ch9 is
begin
Formal := First_Formal (Body_Id);
-- The protected operation always has at least one formal, namely
-- the object itself, but it is only placed in the parameter list
-- if expansion is enabled.
-- The protected operation always has at least one formal, namely the
-- object itself, but it is only placed in the parameter list if
-- expansion is enabled.
if Present (Formal)
or else Expander_Active
then
if Present (Formal) or else Expander_Active then
Plist := Copy_Parameter_List (Body_Id);
else
Plist := No_List;
@ -2584,31 +2582,31 @@ package body Exp_Ch9 is
if Nkind (Specification (N)) = N_Procedure_Specification then
New_Spec :=
Make_Procedure_Specification (Loc,
Defining_Unit_Name =>
Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)),
Parameter_Specifications => Plist);
Parameter_Specifications =>
Plist);
else
New_Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name =>
Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)),
Parameter_Specifications => Plist,
Result_Definition =>
Parameter_Specifications =>
Plist,
Result_Definition =>
New_Occurrence_Of (Etype (Body_Id), Loc));
end if;
Decl :=
Make_Subprogram_Declaration (Loc,
Specification => New_Spec);
Decl := Make_Subprogram_Declaration (Loc, Specification => New_Spec);
Insert_Before (N, Decl);
Spec_Id := Defining_Unit_Name (New_Spec);
-- Indicate that the entity comes from source, to ensure that
-- cross-reference information is properly generated. The body
-- itself is rewritten during expansion, and the body entity will
-- not appear in calls to the operation.
-- Indicate that the entity comes from source, to ensure that cross-
-- reference information is properly generated. The body itself is
-- rewritten during expansion, and the body entity will not appear in
-- calls to the operation.
Set_Comes_From_Source (Spec_Id, True);
Analyze (Decl);
@ -7424,16 +7422,16 @@ package body Exp_Ch9 is
Current_Node := New_Op_Body;
-- Generate an overriding primitive operation body for
-- this subprogram if the protected type implements
-- an interface.
-- this subprogram if the protected type implements an
-- interface.
if Ada_Version >= Ada_05
and then Present (Interfaces (
Corresponding_Record_Type (Pid)))
and then
Present (Interfaces (Corresponding_Record_Type (Pid)))
then
Disp_Op_Body :=
Build_Dispatching_Subprogram_Body (
Op_Body, Pid, New_Op_Body);
Build_Dispatching_Subprogram_Body
(Op_Body, Pid, New_Op_Body);
Insert_After (Current_Node, Disp_Op_Body);
Analyze (Disp_Op_Body);
@ -7494,8 +7492,8 @@ package body Exp_Ch9 is
end loop;
-- Finally, create the body of the function that maps an entry index
-- into the corresponding body index, except when there is no entry,
-- or in a ravenscar-like profile.
-- into the corresponding body index, except when there is no entry, or
-- in a Ravenscar-like profile.
if Corresponding_Runtime_Package (Pid) =
System_Tasking_Protected_Objects_Entries

View File

@ -86,7 +86,7 @@ package Exp_Ch9 is
-- body must be expanded separately to create a subprogram declaration
-- 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
-- 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
-- generated as well.
@ -105,28 +105,28 @@ package Exp_Ch9 is
Name : Node_Id;
Rec : Node_Id;
External : Boolean := True);
-- The node N is a subprogram or entry call to a protected subprogram.
-- This procedure rewrites this call with the appropriate expansion.
-- Name is the subprogram, and Rec is the record corresponding to the
-- protected object. External is False if the call is to another
-- protected subprogram within the same object.
-- The node N is a subprogram or entry call to a protected subprogram. This
-- procedure rewrites this call with the appropriate expansion. Name is the
-- subprogram, and Rec is the record corresponding to the protected object.
-- External is False if the call is to another protected subprogram within
-- the same object.
procedure Build_Task_Activation_Call (N : Node_Id);
-- This procedure is called for constructs that can be task activators
-- i.e. task bodies, subprogram bodies, package bodies and blocks. If
-- the construct is a task activator (as indicated by the non-empty
-- setting of Activation_Chain_Entity, either in the construct, or, in
-- the case of a package body, in its associated package spec), then
-- a call to Activate_Tasks with this entity as the single parameter
-- is inserted at the start of the statements of the activator.
-- This procedure is called for constructs that can be task activators,
-- i.e. task bodies, subprogram bodies, package bodies and blocks. If the
-- construct is a task activator (as indicated by the non-empty setting of
-- Activation_Chain_Entity, either in the construct, or, in the case of a
-- package body, in its associated package spec), then a call to
-- Activate_Tasks with this entity as the single parameter is inserted at
-- the start of the statements of the activator.
procedure Build_Task_Allocate_Block
(Actions : List_Id;
N : Node_Id;
Args : List_Id);
-- This routine is used in the case of allocators where the designated
-- type is a task or contains tasks. In this case, the normal initialize
-- call is replaced by:
-- This routine is used in the case of allocators where the designated type
-- is a task or contains tasks. In this case, the normal initialize call
-- is replaced by:
--
-- blockname : label;
-- blockname : declare
@ -146,10 +146,10 @@ package Exp_Ch9 is
--
-- 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
-- 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
-- for the initialization call, constructed by the caller, which uses
-- the Master_Id of the access type as the _Master parameter, and _Chain
-- 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 for
-- the initialization call, constructed by the caller, which uses the
-- Master_Id of the access type as the _Master parameter, and _Chain
-- (defined above) as the _Chain parameter.
procedure Build_Task_Allocate_Block_With_Init_Stmts
@ -199,28 +199,28 @@ package Exp_Ch9 is
Index : Node_Id;
Ttyp : Entity_Id)
return Node_Id;
-- Returns an expression to compute a task entry index given the name
-- of the entry or entry family. For the case of a task entry family,
-- the Index parameter contains the expression for the subscript.
-- Ttyp is the task type.
-- Returns an expression to compute a task entry index given the name of
-- the entry or entry family. For the case of a task entry family, the
-- Index parameter contains the expression for the subscript. Ttyp is the
-- task type.
procedure Establish_Task_Master (N : Node_Id);
-- Given a subprogram body, or a block statement, or a task body, this
-- procedure makes the necessary transformations required of a task
-- master (add Enter_Master call at start, and establish a cleanup
-- routine to make sure Complete_Master is called on exit).
-- procedure makes the necessary transformations required of a task master
-- (add Enter_Master call at start, and establish a cleanup routine to make
-- sure Complete_Master is called on exit).
procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id);
-- Build Equivalent_Type for an Access_To_Protected_Subprogram.
-- Equivalent_Type is a record type with two components: a pointer
-- to the protected object, and a pointer to the operation itself.
-- Equivalent_Type is a record type with two components: a pointer to the
-- protected object, and a pointer to the operation itself.
procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id);
-- Expand declarations required for accept statement. See bodies of
-- both Expand_Accept_Declarations and Expand_N_Accept_Statement for
-- full details of the nature and use of these declarations, which
-- are inserted immediately before the accept node N. The second
-- argument is the entity for the corresponding entry.
-- Expand declarations required for accept statement. See bodies of both
-- Expand_Accept_Declarations and Expand_N_Accept_Statement for full
-- details of the nature and use of these declarations, which are inserted
-- immediately before the accept node N. The second argument is the entity
-- for the corresponding entry.
procedure Expand_Entry_Barrier (N : Node_Id; Ent : Entity_Id);
-- Expand the entry barrier into a function. This is called directly

View File

@ -1155,7 +1155,7 @@ package body Sem_Prag is
begin
-- 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.
if VM_Target = CLI_Target then

View File

@ -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);
function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
-- Utility to create a parameter profile for a new subprogram spec,
-- when the subprogram has a body that acts as spec. This is done for
-- some cases of inlining, and for private protected ops. Also used
-- to create bodies for stubbed subprograms.
-- Utility to create a parameter profile for a new subprogram spec, when
-- the subprogram has a body that acts as spec. This is done for some cases
-- of inlining, and for private protected ops. Also used to create bodies
-- for stubbed subprograms.
function Current_Entity (N : Node_Id) return Entity_Id;
-- Find the currently visible definition for a given identifier, that is to
@ -230,9 +230,9 @@ package Sem_Util is
function Current_Subprogram return Entity_Id;
-- Returns current enclosing subprogram. If Current_Scope is a subprogram,
-- then that is what is returned, otherwise the Enclosing_Subprogram of
-- the Current_Scope is returned. The returned value is Empty if this
-- is called from a library package which is not within any subprogram.
-- then that is what is returned, otherwise the Enclosing_Subprogram of the
-- Current_Scope is returned. The returned value is Empty if this is called
-- from a library package which is not within any subprogram.
function Defining_Entity (N : Node_Id) return Entity_Id;
-- Given a declaration N, returns the associated defining entity. If

View File

@ -2983,6 +2983,10 @@ package VMS_Data is
"-gnatwv " &
"NOVARIABLES_UNINITIALIZED " &
"-gnatwV " &
"REVERSE_BIT_ORDER " &
"-gnatw.v " &
"NOREVERSE_BIT_ORDER " &
"-gnatw.V " &
"LOWBOUND_ASSUMED " &
"-gnatww " &
"NOLOWBOUND_ASSUMED " &