-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Make_Size_Function : Boolean := False;
-- Indicates whether to request that SO_Ref_From_Expr should
- -- encapsulate the array size expresion in a function.
+ -- encapsulate the array size expression in a function.
procedure Discrimify (N : in out Node_Id);
-- If N represents a discriminant, then the Size.Status is set to
-----------------
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)
end;
end if;
- -- For non-discrete sclar types, if the RM_Size is not set,
+ -- For non-discrete scalar types, if the RM_Size is not set,
-- then set it now to a copy of the Esize if the Esize is set.
else
Set_Composite_Alignment (E);
end if;
- -- Procressing for array types
+ -- Processing for array types
elsif Is_Array_Type (E) then
Align : Nat;
begin
- if Unknown_Alignment (E) then
+ -- If alignment is already set, then nothing to do
+
+ if Known_Alignment (E) then
+ return;
+ end if;
+
+ -- Alignment is not known, see if we can set it, taking into account
+ -- the setting of the Optimize_Alignment mode.
+
+ -- If Optimize_Alignment is set to Space, then packed records always
+ -- have an alignment of 1. But don't do anything for atomic records
+ -- since we may need higher alignment for indivisible access.
+
+ if Optimize_Alignment_Space (E)
+ and then Is_Record_Type (E)
+ and then Is_Packed (E)
+ and then not Is_Atomic (E)
+ then
+ Align := 1;
+
+ -- Not a record, or not packed
+
+ else
+ -- The only other cases we worry about here are where the size is
+ -- statically known at compile time.
+
if Known_Static_Esize (E) then
Siz := Esize (E);
-- Size is known, alignment is not set
- -- Reset alignment to match size if size is exactly 2, 4, or 8
- -- storage units.
+ -- Reset alignment to match size if the known size is exactly 2, 4,
+ -- or 8 storage units.
if Siz = 2 * System_Storage_Unit then
Align := 2;
elsif Siz = 8 * System_Storage_Unit then
Align := 8;
- -- On VMS, also reset for odd "in between" sizes, e.g. a 17-bit
- -- record is given an alignment of 4. This is more consistent with
- -- what DEC Ada does (-gnatd.a turns this off which can be used to
- -- examine the value of this special transformation).
+ -- If Optimize_Alignment is set to Space, then make sure the
+ -- alignment matches the size, for example, if the size is 17
+ -- bytes then we want an alignment of 1 for the type.
- elsif OpenVMS_On_Target
- and then not Debug_Flag_Dot_A
+ elsif Optimize_Alignment_Space (E) then
+ if Siz mod (8 * System_Storage_Unit) = 0 then
+ Align := 8;
+ elsif Siz mod (4 * System_Storage_Unit) = 0 then
+ Align := 4;
+ elsif Siz mod (2 * System_Storage_Unit) = 0 then
+ Align := 2;
+ else
+ Align := 1;
+ end if;
+
+ -- If Optimize_Alignment is set to Time, then we reset for odd
+ -- "in between sizes", for example a 17 bit record is given an
+ -- alignment of 4. Note that this matches the old VMS behavior
+ -- in versions of GNAT prior to 6.1.1.
+
+ elsif Optimize_Alignment_Time (E)
and then Siz > System_Storage_Unit
+ and then Siz <= 8 * System_Storage_Unit
then
if Siz <= 2 * System_Storage_Unit then
Align := 2;
elsif Siz <= 4 * System_Storage_Unit then
Align := 4;
- elsif Siz <= 8 * System_Storage_Unit then
+ else -- Siz <= 8 * System_Storage_Unit then
Align := 8;
- else
- return;
end if;
- -- No special alignment fiddling needed
+ -- No special alignment fiddling needed
else
return;
end if;
+ end if;
- -- Here Align is set to the proposed improved alignment
+ -- Here we have Set Align to the proposed improved value. Make sure the
+ -- value set does not exceed Maximum_Alignment for the target.
- if Align > Maximum_Alignment then
- Align := Maximum_Alignment;
- end if;
+ if Align > Maximum_Alignment then
+ Align := Maximum_Alignment;
+ end if;
- -- Further processing for record types only to reduce the alignment
- -- set by the above processing in some specific cases. We do not
- -- do this for atomic records, since we need max alignment there.
+ -- Further processing for record types only to reduce the alignment
+ -- set by the above processing in some specific cases. We do not
+ -- do this for atomic records, since we need max alignment there,
- if Is_Record_Type (E) then
+ if Is_Record_Type (E) and then not Is_Atomic (E) then
- -- For records, there is generally no point in setting alignment
- -- higher than word size since we cannot do better than move by
- -- words in any case
+ -- For records, there is generally no point in setting alignment
+ -- higher than word size since we cannot do better than move by
+ -- words in any case. Omit this if we are optimizing for time,
+ -- since conceivably we may be able to do better.
- if Align > System_Word_Size / System_Storage_Unit then
- Align := System_Word_Size / System_Storage_Unit;
- end if;
+ if Align > System_Word_Size / System_Storage_Unit
+ and then not Optimize_Alignment_Time (E)
+ then
+ Align := System_Word_Size / System_Storage_Unit;
+ end if;
- -- Check components. If any component requires a higher
- -- alignment, then we set that higher alignment in any case.
+ -- Check components. If any component requires a higher alignment,
+ -- then we set that higher alignment in any case. Don't do this if
+ -- we have Optimize_Alignment set to Space. Note that that covers
+ -- the case of packed records, where we already set alignment to 1.
+ if not Optimize_Alignment_Space (E) then
declare
Comp : Entity_Id;
Calign : constant Uint := Alignment (Etype (Comp));
begin
- -- The cases to worry about are when the alignment
- -- of the component type is larger than the alignment
- -- we have so far, and either there is no component
- -- clause for the alignment, or the length set by
- -- the component clause matches the alignment set.
+ -- The cases to process are when the alignment of the
+ -- component type is larger than the alignment we have
+ -- so far, and either there is no component clause for
+ -- the component, or the length set by the component
+ -- clause matches the length of the component type.
if Calign > Align
and then
(Unknown_Esize (Comp)
- or else (Known_Static_Esize (Comp)
- and then
- Esize (Comp) =
- Calign * System_Storage_Unit))
+ or else (Known_Static_Esize (Comp)
+ and then
+ Esize (Comp) =
+ Calign * System_Storage_Unit))
then
Align := UI_To_Int (Calign);
end if;
end loop;
end;
end if;
+ end if;
- -- Set chosen alignment
+ -- Set chosen alignment, and increase Esize if necessary to match
+ -- the chosen alignment.
- Set_Alignment (E, UI_From_Int (Align));
+ Set_Alignment (E, UI_From_Int (Align));
- if Known_Static_Esize (E)
- and then Esize (E) < Align * System_Storage_Unit
- then
- Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
- end if;
+ if Known_Static_Esize (E)
+ and then Esize (E) < Align * System_Storage_Unit
+ then
+ Set_Esize (E, UI_From_Int (Align * System_Storage_Unit));
end if;
end Set_Composite_Alignment;
OSDN Git Service
