-----------------
procedure Layout_Type (E : Entity_Id) is
+ Desig_Type : Entity_Id;
+
begin
-- For string literal types, for now, kill the size always, this
-- is because gigi does not like or need the size to be set ???
if Is_Access_Type (E) then
+ Desig_Type := Underlying_Type (Designated_Type (E));
+
+ -- If we only have a limited view of the type, see whether the
+ -- non-limited view is available.
+
+ if From_With_Type (Designated_Type (E))
+ and then Ekind (Designated_Type (E)) = E_Incomplete_Type
+ and then Present (Non_Limited_View (Designated_Type (E)))
+ then
+ Desig_Type := Non_Limited_View (Designated_Type (E));
+ end if;
+
-- If Esize already set (e.g. by a size clause), then nothing
-- further to be done here.
-- a fat pointer is used (pointer-to-unconstrained array case),
-- twice the address size to accommodate a fat pointer.
- elsif Present (Underlying_Type (Designated_Type (E)))
- and then Is_Array_Type (Underlying_Type (Designated_Type (E)))
- and then not Is_Constrained (Underlying_Type (Designated_Type (E)))
- and then not Has_Completion_In_Body (Underlying_Type
- (Designated_Type (E)))
+ elsif Present (Desig_Type)
+ and then Is_Array_Type (Desig_Type)
+ and then not Is_Constrained (Desig_Type)
+ and then not Has_Completion_In_Body (Desig_Type)
and then not Debug_Flag_6
then
Init_Size (E, 2 * System_Address_Size);
("?this access type does not correspond to C pointer", E);
end if;
+ -- If the designated type is a limited view it is unanalyzed. We
+ -- can examine the declaration itself to determine whether it will
+ -- need a fat pointer.
+
+ elsif Present (Desig_Type)
+ and then Present (Parent (Desig_Type))
+ and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
+ and then
+ Nkind (Type_Definition (Parent (Desig_Type)))
+ = N_Unconstrained_Array_Definition
+ then
+ Init_Size (E, 2 * System_Address_Size);
+
-- When the target is AAMP, access-to-subprogram types are fat
-- pointers consisting of the subprogram address and a static
-- link (with the exception of library-level access types,
-- for this purpose, since it would be weird not to inherit the size
-- in this case.
- if OpenVMS_On_Target
+ -- We do NOT do this if we are in -gnatdm mode on a non-VMS target
+ -- since in that case we want the normal pointer representation.
+
+ if Opt.True_VMS_Target
and then (Convention (E) = Convention_C
or else
Convention (E) = Convention_CPP)
if Is_Entity_Name (P)
and then Is_Overloadable (Entity (P))
then
- -- Not allowed for nested subprograms if No_Implicit_Dynamic_Code
- -- restriction set (since in general a trampoline is required).
-
- if not Is_Library_Level_Entity (Entity (P)) then
- Check_Restriction (No_Implicit_Dynamic_Code, P);
- end if;
-
- if Is_Always_Inlined (Entity (P)) then
+ if Has_Pragma_Inline_Always (Entity (P)) then
Error_Attr_P
("prefix of % attribute cannot be Inline_Always subprogram");
end if;
then
Error_Attr ("only allowed prefix for % attribute is Standard", P);
end if;
-
end Check_Standard_Prefix;
----------------------------
begin
if Is_Subprogram (Ent) then
- if not Is_Library_Level_Entity (Ent) then
- Check_Restriction (No_Implicit_Dynamic_Code, P);
- end if;
-
Set_Address_Taken (Ent);
Kill_Current_Values (Ent);
-- errors about implicit uses of Address in the dispatch
-- table initialization).
- if Is_Always_Inlined (Entity (P))
+ if Has_Pragma_Inline_Always (Entity (P))
and then Comes_From_Source (P)
then
Error_Attr_P
Error_Attr_P ("prefix of % attribute must be tagged");
end if;
+ ---------------
+ -- Fast_Math --
+ ---------------
+
+ when Attribute_Fast_Math =>
+ Check_E0;
+ Check_Standard_Prefix;
+
+ if Opt.Fast_Math then
+ Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
+ else
+ Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
+ end if;
+
-----------
-- First --
-----------
if Comes_From_Source (N) then
Check_Not_Incomplete_Type;
end if;
+
+ -- Set appropriate type
+
Set_Etype (N, RTE (RE_Tag));
-----------------
Attribute_Elab_Spec |
Attribute_Enabled |
Attribute_External_Tag |
+ Attribute_Fast_Math |
Attribute_First_Bit |
Attribute_Input |
Attribute_Last_Bit |
end if;
end if;
+ Des_Btyp := Designated_Type (Btyp);
+
+ if Ada_Version >= Ada_05
+ and then Is_Incomplete_Type (Des_Btyp)
+ then
+ -- Ada 2005 (AI-412): If the (sub)type is a limited view of an
+ -- imported entity, and the non-limited view is visible, make
+ -- use of it. If it is an incomplete subtype, use the base type
+ -- in any case.
+
+ if From_With_Type (Des_Btyp)
+ and then Present (Non_Limited_View (Des_Btyp))
+ then
+ Des_Btyp := Non_Limited_View (Des_Btyp);
+
+ elsif Ekind (Des_Btyp) = E_Incomplete_Subtype then
+ Des_Btyp := Etype (Des_Btyp);
+ end if;
+ end if;
+
if (Attr_Id = Attribute_Access
or else
Attr_Id = Attribute_Unchecked_Access)
Nom_Subt := Base_Type (Nom_Subt);
end if;
- Des_Btyp := Designated_Type (Btyp);
-
- if Ekind (Des_Btyp) = E_Incomplete_Subtype then
-
- -- Ada 2005 (AI-412): Subtypes of incomplete types visible
- -- through a limited with clause or regular incomplete
- -- subtypes.
-
- if From_With_Type (Des_Btyp)
- and then Present (Non_Limited_View (Des_Btyp))
- then
- Des_Btyp := Non_Limited_View (Des_Btyp);
- else
- Des_Btyp := Etype (Des_Btyp);
- end if;
- end if;
-
if Is_Tagged_Type (Designated_Type (Typ)) then
-- If the attribute is in the context of an access
-- (because access values must be assumed to designate mutable
-- objects when designated type does not impose a constraint).
- elsif not Subtypes_Statically_Match (Des_Btyp, Nom_Subt)
+ elsif Subtypes_Statically_Match (Des_Btyp, Nom_Subt) then
+ null;
+
+ elsif Has_Discriminants (Designated_Type (Typ))
+ and then not Is_Constrained (Des_Btyp)
and then
- not (Has_Discriminants (Designated_Type (Typ))
- and then not Is_Constrained (Des_Btyp)
- and then
- (Ada_Version < Ada_05
- or else
- not Has_Constrained_Partial_View
- (Designated_Type (Base_Type (Typ)))))
+ (Ada_Version < Ada_05
+ or else
+ not Has_Constrained_Partial_View
+ (Designated_Type (Base_Type (Typ))))
then
+ null;
+
+ else
Error_Msg_F
("object subtype must statically match "
& "designated subtype", P);
projects / gcc.git / commitdiff