1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
29 with Sinfo
; use Sinfo
;
30 with Stand
; use Stand
;
31 with Targparm
; use Targparm
;
33 package body Itypes
is
41 Related_Nod
: Node_Id
;
42 Related_Id
: Entity_Id
:= Empty
;
43 Suffix
: Character := ' ';
44 Suffix_Index
: Nat
:= 0;
45 Scope_Id
: Entity_Id
:= Current_Scope
) return Entity_Id
50 if Related_Id
= Empty
then
51 Typ
:= New_Internal_Entity
(Ekind
, Scope_Id
, Sloc
(Related_Nod
), 'T');
52 Set_Public_Status
(Typ
);
55 Typ
:= New_External_Entity
56 (Ekind
, Scope_Id
, Sloc
(Related_Nod
), Related_Id
, Suffix
,
60 Init_Size_Align
(Typ
);
61 Set_Etype
(Typ
, Any_Type
);
63 Set_Associated_Node_For_Itype
(Typ
, Related_Nod
);
66 and then not ASIS_Mode
71 if Ekind
in Access_Subprogram_Type_Kind
then
72 Set_Can_Use_Internal_Rep
(Typ
, not Always_Compatible_Rep_On_Target
);
78 ---------------------------------
79 -- Create_Null_Excluding_Itype --
80 ---------------------------------
82 function Create_Null_Excluding_Itype
84 Related_Nod
: Node_Id
;
85 Scope_Id
: Entity_Id
:= Current_Scope
) return Entity_Id
90 pragma Assert
(Is_Access_Type
(T
));
92 I_Typ
:= Create_Itype
(Ekind
=> E_Access_Subtype
,
93 Related_Nod
=> Related_Nod
,
94 Scope_Id
=> Scope_Id
);
96 Set_Directly_Designated_Type
(I_Typ
, Directly_Designated_Type
(T
));
98 Init_Size_Align
(I_Typ
);
99 Set_Depends_On_Private
(I_Typ
, Depends_On_Private
(T
));
100 Set_Is_Public
(I_Typ
, Is_Public
(T
));
101 Set_From_With_Type
(I_Typ
, From_With_Type
(T
));
102 Set_Is_Access_Constant
(I_Typ
, Is_Access_Constant
(T
));
103 Set_Is_Generic_Type
(I_Typ
, Is_Generic_Type
(T
));
104 Set_Is_Volatile
(I_Typ
, Is_Volatile
(T
));
105 Set_Treat_As_Volatile
(I_Typ
, Treat_As_Volatile
(T
));
106 Set_Is_Atomic
(I_Typ
, Is_Atomic
(T
));
107 Set_Is_Ada_2005_Only
(I_Typ
, Is_Ada_2005_Only
(T
));
108 Set_Can_Never_Be_Null
(I_Typ
);
111 end Create_Null_Excluding_Itype
;