Commit c95e0edc by Arnaud Charlet

Minor reformatting.

From-SVN: r165693
parent 4adf3c50
...@@ -4348,24 +4348,19 @@ package body Exp_Ch4 is ...@@ -4348,24 +4348,19 @@ package body Exp_Ch4 is
R : constant Node_Id := Relocate_Node (Alt); R : constant Node_Id := Relocate_Node (Alt);
begin begin
if (Is_Entity_Name (Alt) if (Is_Entity_Name (Alt) and then Is_Type (Entity (Alt)))
and then Is_Type (Entity (Alt))) or else Nkind (Alt) = N_Range
or else Nkind (Alt) = N_Range
then then
Cond := Cond := Make_In (Sloc (Alt), Left_Opnd => L, Right_Opnd => R);
Make_In (Sloc (Alt),
Left_Opnd => L,
Right_Opnd => R);
else else
Cond := Make_Op_Eq (Sloc (Alt), Cond :=
Left_Opnd => L, Make_Op_Eq (Sloc (Alt), Left_Opnd => L, Right_Opnd => R);
Right_Opnd => R);
end if; end if;
return Cond; return Cond;
end Make_Cond; end Make_Cond;
-- Start of proessing for Expand_N_In -- Start of processing for Expand_N_In
begin begin
Alt := Last (Alternatives (N)); Alt := Last (Alternatives (N));
...@@ -4419,7 +4414,7 @@ package body Exp_Ch4 is ...@@ -4419,7 +4414,7 @@ package body Exp_Ch4 is
-- Check case of explicit test for an expression in range of its -- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid -- 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 -- 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. -- typically be a pessimization.
if Is_Scalar_Type (Etype (Lop)) if Is_Scalar_Type (Etype (Lop))
...@@ -4475,17 +4470,19 @@ package body Exp_Ch4 is ...@@ -4475,17 +4470,19 @@ package body Exp_Ch4 is
-- the same as the type of the expression. -- the same as the type of the expression.
begin 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) if Is_Scalar_Type (Ltyp)
and then Nkind (Lo_Orig) = N_Attribute_Reference and then Nkind (Lo_Orig) = N_Attribute_Reference
and then Attribute_Name (Lo_Orig) = Name_First and then Attribute_Name (Lo_Orig) = Name_First
and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity
and then Entity (Prefix (Lo_Orig)) = Ltyp and then Entity (Prefix (Lo_Orig)) = Ltyp
and then Nkind (Hi_Orig) = N_Attribute_Reference and then Nkind (Hi_Orig) = N_Attribute_Reference
and then Attribute_Name (Hi_Orig) = Name_Last and then Attribute_Name (Hi_Orig) = Name_Last
and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity
and then Entity (Prefix (Hi_Orig)) = Ltyp and then Entity (Prefix (Hi_Orig)) = Ltyp
and then Comes_From_Source (N) and then Comes_From_Source (N)
and then VM_Target = No_VM and then VM_Target = No_VM
then then
...@@ -4669,7 +4666,7 @@ package body Exp_Ch4 is ...@@ -4669,7 +4666,7 @@ package body Exp_Ch4 is
return; 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 -- This reason we do this is that the bounds may have the wrong
-- type if they come from the original type definition. Also this -- type if they come from the original type definition. Also this
-- way we get all the processing above for an explicit range. -- way we get all the processing above for an explicit range.
......
...@@ -1661,21 +1661,22 @@ package body Exp_Ch9 is ...@@ -1661,21 +1661,22 @@ package body Exp_Ch9 is
Make_Parameter_Specification (Loc, Make_Parameter_Specification (Loc,
Defining_Identifier => Index, Defining_Identifier => Index,
Parameter_Type => Parameter_Type =>
New_Occurrence_Of (Entry_Index_Type (E), Loc))); New_Occurrence_Of (Entry_Index_Type (E), Loc)));
Entry_Name := Make_Indexed_Component (Loc, Entry_Name :=
Prefix => Entry_Name, Make_Indexed_Component (Loc,
Expressions => New_List (New_Occurrence_Of (Index, Loc))); Prefix => Entry_Name,
Expressions => New_List (New_Occurrence_Of (Index, Loc)));
end; end;
end if; end if;
Entry_Call := Entry_Call :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Entry_Name, Name => Entry_Name,
Parameter_Associations => Actuals); Parameter_Associations => Actuals);
-- Now add formals that match those of the entry, and build actuals -- Now add formals that match those of the entry, and build actuals for
-- for the nested entry call. -- the nested entry call.
declare declare
Form : Entity_Id; Form : Entity_Id;
...@@ -1689,8 +1690,8 @@ package body Exp_Ch9 is ...@@ -1689,8 +1690,8 @@ package body Exp_Ch9 is
Parm_Spec := Parm_Spec :=
Make_Parameter_Specification (Loc, Make_Parameter_Specification (Loc,
Defining_Identifier => New_Form, Defining_Identifier => New_Form,
Out_Present => Out_Present (Parent (Form)), Out_Present => Out_Present (Parent (Form)),
In_Present => In_Present (Parent (Form)), In_Present => In_Present (Parent (Form)),
Parameter_Type => New_Occurrence_Of (Etype (Form), Loc)); Parameter_Type => New_Occurrence_Of (Etype (Form), Loc));
Append (Parm_Spec, Specs); Append (Parm_Spec, Specs);
...@@ -1728,16 +1729,16 @@ package body Exp_Ch9 is ...@@ -1728,16 +1729,16 @@ package body Exp_Ch9 is
Set_PPC_Wrapper (E, Wrapper_Id); Set_PPC_Wrapper (E, Wrapper_Id);
Wrapper_Body := Wrapper_Body :=
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
Specification => Specification =>
Make_Procedure_Specification (Loc, Make_Procedure_Specification (Loc,
Defining_Unit_Name => Wrapper_Id, Defining_Unit_Name => Wrapper_Id,
Parameter_Specifications => Specs), Parameter_Specifications => Specs),
Declarations => Decls, Declarations => Decls,
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Entry_Call))); 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); Append_Freeze_Action (Defining_Entity (Decl), Wrapper_Body);
end Build_PPC_Wrapper; end Build_PPC_Wrapper;
...@@ -1857,7 +1858,7 @@ package body Exp_Ch9 is ...@@ -1857,7 +1858,7 @@ package body Exp_Ch9 is
Nam := Nam :=
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix =>
Unchecked_Convert_To Unchecked_Convert_To
(Corresponding_Concurrent_Type (Obj_Typ), Conv_Id), (Corresponding_Concurrent_Type (Obj_Typ), Conv_Id),
Selector_Name => New_Reference_To (Subp_Id, Loc)); Selector_Name => New_Reference_To (Subp_Id, Loc));
......
...@@ -6263,11 +6263,14 @@ package body Exp_Disp is ...@@ -6263,11 +6263,14 @@ package body Exp_Disp is
-- Import the dispatch table DT of tagged type Tag_Typ. Required to -- Import the dispatch table DT of tagged type Tag_Typ. Required to
-- generate forward references and statically allocate the table. For -- generate forward references and statically allocate the table. For
-- primary dispatch tables that require no dispatch table generate: -- primary dispatch tables that require no dispatch table generate:
-- DT : static aliased constant Non_Dispatch_Table_Wrapper; -- DT : static aliased constant Non_Dispatch_Table_Wrapper;
-- $pragma import (ada, DT); -- pragma Import (Ada, DT);
-- Otherwise generate: -- Otherwise generate:
-- DT : static aliased constant Dispatch_Table_Wrapper (Nb_Prim); -- DT : static aliased constant Dispatch_Table_Wrapper (Nb_Prim);
-- $pragma import (ada, DT); -- pragma Import (Ada, DT);
--------------- ---------------
-- Import_DT -- -- Import_DT --
...@@ -6292,8 +6295,7 @@ package body Exp_Disp is ...@@ -6292,8 +6295,7 @@ package body Exp_Disp is
Get_External_Name (DT, True); Get_External_Name (DT, True);
Set_Interface_Name (DT, Set_Interface_Name (DT,
Make_String_Literal (Loc, Make_String_Literal (Loc, Strval => String_From_Name_Buffer));
Strval => String_From_Name_Buffer));
-- Ensure proper Sprint output of this implicit importation -- Ensure proper Sprint output of this implicit importation
...@@ -6305,9 +6307,7 @@ package body Exp_Disp is ...@@ -6305,9 +6307,7 @@ package body Exp_Disp is
-- No dispatch table required -- No dispatch table required
if not Is_Secondary_DT if not Is_Secondary_DT and then not Has_DT (Tag_Typ) then
and then not Has_DT (Tag_Typ)
then
Append_To (Result, Append_To (Result,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => DT, Defining_Identifier => DT,
...@@ -6323,8 +6323,8 @@ package body Exp_Disp is ...@@ -6323,8 +6323,8 @@ package body Exp_Disp is
Nb_Prim := Nb_Prim :=
UI_To_Int (DT_Entry_Count (First_Tag_Component (Tag_Typ))); UI_To_Int (DT_Entry_Count (First_Tag_Component (Tag_Typ)));
-- If the tagged type has no primitives we add a dummy slot -- If the tagged type has no primitives we add a dummy slot whose
-- whose address will be the tag of this type. -- address will be the tag of this type.
if Nb_Prim = 0 then if Nb_Prim = 0 then
DT_Constr_List := DT_Constr_List :=
...@@ -6384,8 +6384,8 @@ package body Exp_Disp is ...@@ -6384,8 +6384,8 @@ package body Exp_Disp is
-- For CPP types there is no need to build the dispatch tables since -- 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 -- 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. -- 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, -- If the CPP type is an interface, we need the variable as well because
-- because it becomes the pointer to the corresponding secondary table. -- it becomes the pointer to the corresponding secondary table.
if Is_CPP_Class (Typ) then if Is_CPP_Class (Typ) then
if Has_CPP_Constructors (Typ) or else Is_Interface (Typ) then if Has_CPP_Constructors (Typ) or else Is_Interface (Typ) then
...@@ -6413,7 +6413,7 @@ package body Exp_Disp is ...@@ -6413,7 +6413,7 @@ package body Exp_Disp is
Append_Elmt (Predef_Prims_Ptr, Access_Disp_Table (Typ)); Append_Elmt (Predef_Prims_Ptr, Access_Disp_Table (Typ));
-- Import the forward declaration of the Dispatch Table wrapper -- 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 if Building_Static_DT (Typ) then
Set_Dispatch_Table_Wrappers (Typ, New_Elmt_List); Set_Dispatch_Table_Wrappers (Typ, New_Elmt_List);
...@@ -6499,12 +6499,12 @@ package body Exp_Disp is ...@@ -6499,12 +6499,12 @@ package body Exp_Disp is
if Has_Interfaces (Typ) then if Has_Interfaces (Typ) then
Collect_Interface_Components (Typ, Typ_Comps); Collect_Interface_Components (Typ, Typ_Comps);
-- For each interface type we build an unique external name -- For each interface type we build a unique external name associated
-- associated with its secondary dispatch table. This name is used to -- with its secondary dispatch table. This name is used to declare an
-- declare an object that references this secondary dispatch table, -- object that references this secondary dispatch table, whose value
-- value that will be used for the elaboration of Typ's objects and -- will be used for the elaboration of Typ objects, and also for the
-- also for the elaboration of objects of derivations of Typ that do -- elaboration of objects of types derived from Typ that do not
-- not override the primitives of this interface type. -- override the primitives of this interface type.
Suffix_Index := 1; Suffix_Index := 1;
...@@ -6520,7 +6520,7 @@ package body Exp_Disp is ...@@ -6520,7 +6520,7 @@ package body Exp_Disp is
Typ_Name := Name_Find; Typ_Name := Name_Find;
-- Declare variables that will store the copy of the C++ -- Declare variables that will store the copy of the C++
-- secondary tags -- secondary tags.
Iface_DT_Ptr := Iface_DT_Ptr :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
...@@ -6727,6 +6727,7 @@ package body Exp_Disp is ...@@ -6727,6 +6727,7 @@ package body Exp_Disp is
-- Add the freezing nodes of these declarations; required to avoid -- Add the freezing nodes of these declarations; required to avoid
-- generating these freezing nodes in wrong scopes (for example in -- generating these freezing nodes in wrong scopes (for example in
-- the IC routine of a derivation of Typ). -- 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, Typ));
Append_List_To (Result, Freeze_Entity (DT_Prims_Acc, Typ)); Append_List_To (Result, Freeze_Entity (DT_Prims_Acc, Typ));
......
...@@ -36,7 +36,7 @@ with System; ...@@ -36,7 +36,7 @@ with System;
package Interfaces.C.Extensions is 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 is System.Address;
subtype void_ptr is System.Address; subtype void_ptr is System.Address;
...@@ -55,12 +55,12 @@ package Interfaces.C.Extensions is ...@@ -55,12 +55,12 @@ package Interfaces.C.Extensions is
subtype bool is plain_char; subtype bool is plain_char;
-- 64bit integer types -- 64-bit integer types
subtype long_long is Long_Long_Integer; subtype long_long is Long_Long_Integer;
type unsigned_long_long is mod 2 ** 64; 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))); -- typedef int signed_128 __attribute__ ((mode (TI)));
type Signed_128 is record type Signed_128 is record
......
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