Minor reformatting.
From-SVN: r165693
This commit is contained in:
parent
4adf3c50f1
commit
c95e0edc45
@ -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.
|
||||
|
@ -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));
|
||||
|
@ -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));
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user