Minor reformatting.

From-SVN: r165693
This commit is contained in:
Arnaud Charlet 2010-10-19 12:30:52 +02:00
parent 4adf3c50f1
commit c95e0edc45
4 changed files with 52 additions and 53 deletions

View File

@ -4348,24 +4348,19 @@ package body Exp_Ch4 is
R : constant Node_Id := Relocate_Node (Alt);
begin
if (Is_Entity_Name (Alt)
and then Is_Type (Entity (Alt)))
or else Nkind (Alt) = N_Range
if (Is_Entity_Name (Alt) and then Is_Type (Entity (Alt)))
or else Nkind (Alt) = N_Range
then
Cond :=
Make_In (Sloc (Alt),
Left_Opnd => L,
Right_Opnd => R);
Cond := Make_In (Sloc (Alt), Left_Opnd => L, Right_Opnd => R);
else
Cond := Make_Op_Eq (Sloc (Alt),
Left_Opnd => L,
Right_Opnd => R);
Cond :=
Make_Op_Eq (Sloc (Alt), Left_Opnd => L, Right_Opnd => R);
end if;
return Cond;
end Make_Cond;
-- Start of proessing for Expand_N_In
-- Start of processing for Expand_N_In
begin
Alt := Last (Alternatives (N));
@ -4419,7 +4414,7 @@ package body Exp_Ch4 is
-- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid
-- test and give a warning. For floating point types however, this is a
-- standard way to check for finite numbers, and using 'Valid vould
-- standard way to check for finite numbers, and using 'Valid would
-- typically be a pessimization.
if Is_Scalar_Type (Etype (Lop))
@ -4475,17 +4470,19 @@ package body Exp_Ch4 is
-- the same as the type of the expression.
begin
-- If test is explicit x'first .. x'last, replace by valid check
-- If test is explicit x'First .. x'Last, replace by valid check
if Is_Scalar_Type (Ltyp)
and then Nkind (Lo_Orig) = N_Attribute_Reference
and then Attribute_Name (Lo_Orig) = Name_First
and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity
and then Entity (Prefix (Lo_Orig)) = Ltyp
and then Nkind (Hi_Orig) = N_Attribute_Reference
and then Attribute_Name (Hi_Orig) = Name_Last
and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity
and then Entity (Prefix (Hi_Orig)) = Ltyp
and then Comes_From_Source (N)
and then VM_Target = No_VM
then
@ -4669,7 +4666,7 @@ package body Exp_Ch4 is
return;
-- If type is scalar type, rewrite as x in t'first .. t'last.
-- If type is scalar type, rewrite as x in t'First .. t'Last.
-- This reason we do this is that the bounds may have the wrong
-- type if they come from the original type definition. Also this
-- way we get all the processing above for an explicit range.

View File

@ -1661,21 +1661,22 @@ package body Exp_Ch9 is
Make_Parameter_Specification (Loc,
Defining_Identifier => Index,
Parameter_Type =>
New_Occurrence_Of (Entry_Index_Type (E), Loc)));
New_Occurrence_Of (Entry_Index_Type (E), Loc)));
Entry_Name := Make_Indexed_Component (Loc,
Prefix => Entry_Name,
Expressions => New_List (New_Occurrence_Of (Index, Loc)));
Entry_Name :=
Make_Indexed_Component (Loc,
Prefix => Entry_Name,
Expressions => New_List (New_Occurrence_Of (Index, Loc)));
end;
end if;
Entry_Call :=
Make_Procedure_Call_Statement (Loc,
Name => Entry_Name,
Name => Entry_Name,
Parameter_Associations => Actuals);
-- Now add formals that match those of the entry, and build actuals
-- for the nested entry call.
-- Now add formals that match those of the entry, and build actuals for
-- the nested entry call.
declare
Form : Entity_Id;
@ -1689,8 +1690,8 @@ package body Exp_Ch9 is
Parm_Spec :=
Make_Parameter_Specification (Loc,
Defining_Identifier => New_Form,
Out_Present => Out_Present (Parent (Form)),
In_Present => In_Present (Parent (Form)),
Out_Present => Out_Present (Parent (Form)),
In_Present => In_Present (Parent (Form)),
Parameter_Type => New_Occurrence_Of (Etype (Form), Loc));
Append (Parm_Spec, Specs);
@ -1728,16 +1729,16 @@ package body Exp_Ch9 is
Set_PPC_Wrapper (E, Wrapper_Id);
Wrapper_Body :=
Make_Subprogram_Body (Loc,
Specification =>
Specification =>
Make_Procedure_Specification (Loc,
Defining_Unit_Name => Wrapper_Id,
Defining_Unit_Name => Wrapper_Id,
Parameter_Specifications => Specs),
Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Entry_Call)));
Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Entry_Call)));
-- The wrapper body is analyzed when the enclosing type is frozen.
-- The wrapper body is analyzed when the enclosing type is frozen
Append_Freeze_Action (Defining_Entity (Decl), Wrapper_Body);
end Build_PPC_Wrapper;
@ -1857,7 +1858,7 @@ package body Exp_Ch9 is
Nam :=
Make_Selected_Component (Loc,
Prefix =>
Prefix =>
Unchecked_Convert_To
(Corresponding_Concurrent_Type (Obj_Typ), Conv_Id),
Selector_Name => New_Reference_To (Subp_Id, Loc));

View File

@ -6263,11 +6263,14 @@ package body Exp_Disp is
-- Import the dispatch table DT of tagged type Tag_Typ. Required to
-- generate forward references and statically allocate the table. For
-- primary dispatch tables that require no dispatch table generate:
-- DT : static aliased constant Non_Dispatch_Table_Wrapper;
-- $pragma import (ada, DT);
-- pragma Import (Ada, DT);
-- Otherwise generate:
-- DT : static aliased constant Dispatch_Table_Wrapper (Nb_Prim);
-- $pragma import (ada, DT);
-- pragma Import (Ada, DT);
---------------
-- Import_DT --
@ -6292,8 +6295,7 @@ package body Exp_Disp is
Get_External_Name (DT, True);
Set_Interface_Name (DT,
Make_String_Literal (Loc,
Strval => String_From_Name_Buffer));
Make_String_Literal (Loc, Strval => String_From_Name_Buffer));
-- Ensure proper Sprint output of this implicit importation
@ -6305,9 +6307,7 @@ package body Exp_Disp is
-- No dispatch table required
if not Is_Secondary_DT
and then not Has_DT (Tag_Typ)
then
if not Is_Secondary_DT and then not Has_DT (Tag_Typ) then
Append_To (Result,
Make_Object_Declaration (Loc,
Defining_Identifier => DT,
@ -6323,8 +6323,8 @@ package body Exp_Disp is
Nb_Prim :=
UI_To_Int (DT_Entry_Count (First_Tag_Component (Tag_Typ)));
-- If the tagged type has no primitives we add a dummy slot
-- whose address will be the tag of this type.
-- If the tagged type has no primitives we add a dummy slot whose
-- address will be the tag of this type.
if Nb_Prim = 0 then
DT_Constr_List :=
@ -6384,8 +6384,8 @@ package body Exp_Disp is
-- For CPP types there is no need to build the dispatch tables since
-- they are imported from the C++ side. If the CPP type has an IP then
-- we declare now the variable that will store the copy of the C++ tag.
-- If the CPP type is an interface, we need the variable as well,
-- because it becomes the pointer to the corresponding secondary table.
-- If the CPP type is an interface, we need the variable as well because
-- it becomes the pointer to the corresponding secondary table.
if Is_CPP_Class (Typ) then
if Has_CPP_Constructors (Typ) or else Is_Interface (Typ) then
@ -6413,7 +6413,7 @@ package body Exp_Disp is
Append_Elmt (Predef_Prims_Ptr, Access_Disp_Table (Typ));
-- Import the forward declaration of the Dispatch Table wrapper
-- record (Make_DT will take care of its exportation)
-- record (Make_DT will take care of exporting it).
if Building_Static_DT (Typ) then
Set_Dispatch_Table_Wrappers (Typ, New_Elmt_List);
@ -6499,12 +6499,12 @@ package body Exp_Disp is
if Has_Interfaces (Typ) then
Collect_Interface_Components (Typ, Typ_Comps);
-- For each interface type we build an unique external name
-- associated with its secondary dispatch table. This name is used to
-- declare an object that references this secondary dispatch table,
-- value that will be used for the elaboration of Typ's objects and
-- also for the elaboration of objects of derivations of Typ that do
-- not override the primitives of this interface type.
-- For each interface type we build a unique external name associated
-- with its secondary dispatch table. This name is used to declare an
-- object that references this secondary dispatch table, whose value
-- will be used for the elaboration of Typ objects, and also for the
-- elaboration of objects of types derived from Typ that do not
-- override the primitives of this interface type.
Suffix_Index := 1;
@ -6520,7 +6520,7 @@ package body Exp_Disp is
Typ_Name := Name_Find;
-- Declare variables that will store the copy of the C++
-- secondary tags
-- secondary tags.
Iface_DT_Ptr :=
Make_Defining_Identifier (Loc,
@ -6727,6 +6727,7 @@ package body Exp_Disp is
-- Add the freezing nodes of these declarations; required to avoid
-- generating these freezing nodes in wrong scopes (for example in
-- the IC routine of a derivation of Typ).
-- What is an "IC routine"? Is "init_proc" meant here???
Append_List_To (Result, Freeze_Entity (DT_Prims, Typ));
Append_List_To (Result, Freeze_Entity (DT_Prims_Acc, Typ));

View File

@ -36,7 +36,7 @@ with System;
package Interfaces.C.Extensions is
-- Definitions for C "void" and "void*" types
-- Definitions for C "void" and "void *" types
subtype void is System.Address;
subtype void_ptr is System.Address;
@ -55,12 +55,12 @@ package Interfaces.C.Extensions is
subtype bool is plain_char;
-- 64bit integer types
-- 64-bit integer types
subtype long_long is Long_Long_Integer;
type unsigned_long_long is mod 2 ** 64;
-- 128bit integer type available on 64bit platforms:
-- 128-bit integer type available on 64-bit platforms:
-- typedef int signed_128 __attribute__ ((mode (TI)));
type Signed_128 is record