Commit 7d8b9c99 by Robert Dewar Committed by Arnaud Charlet

exp_pakd.adb (Expand_Packed_Not): Use RM_Size rather than ESize to compute masking constant...

2007-04-20  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* exp_pakd.adb (Expand_Packed_Not): Use RM_Size rather than ESize to
	compute masking constant, since we now set Esize properly to the
	underlying size.
	(Create_Packed_Array_Type): Set proper Esize value adjusted as required
	to match the alignment.
	(Create_Packed_Array_Type): Use Short_Short_Unsigned as base type for
	packed arrays of 8 bits or less.

	* freeze.adb (Freeze_Entity): When freezing the formals of a
	subprogram, freeze the designated type of a parameter of an access type
	only if it is an access parameter.
	Increase size of C convention enumeration object
	(Freeze_Entity, array type case): Make sure Esize value is properly
	adjusted for the alignment if it is known.
	(Freeze_Entity, array type case): When checking bit packed arrays for
	the size being incorrect, check RM_Size, not Esize.
	(Freeze_Record_Type): Check for bad discriminated record convention
	(In_Exp_Body): Return true if the body is generated for a subprogram
	renaming, either an attribute renaming or a renaming as body.
	(Check_Itype): If the designated type of an anonymous access component
	is a non-protected subprogram type, indicate that it is frozen, to
	prevent out-of-scope freeze node at some subsequent call.
	(Freeze_Subprogram): On OpenVMS, reject descriptor passing mechanism
	only if the subprogram is neither imported nor exported, as well as the
	NCA descriptor class if the subprogram is exported.

From-SVN: r125407
parent b545a0f6
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -30,6 +30,8 @@ with Einfo; use Einfo; ...@@ -30,6 +30,8 @@ with Einfo; use Einfo;
with Errout; use Errout; with Errout; use Errout;
with Exp_Dbug; use Exp_Dbug; with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util; with Exp_Util; use Exp_Util;
with Layout; use Layout;
with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Rtsfind; use Rtsfind; with Rtsfind; use Rtsfind;
...@@ -772,7 +774,7 @@ package body Exp_Pakd is ...@@ -772,7 +774,7 @@ package body Exp_Pakd is
end if; end if;
if Scope (Typ) /= Current_Scope then if Scope (Typ) /= Current_Scope then
New_Scope (Scope (Typ)); Push_Scope (Scope (Typ));
Pushed_Scope := True; Pushed_Scope := True;
end if; end if;
...@@ -785,15 +787,19 @@ package body Exp_Pakd is ...@@ -785,15 +787,19 @@ package body Exp_Pakd is
end if; end if;
-- Set Esize and RM_Size to the actual size of the packed object -- Set Esize and RM_Size to the actual size of the packed object
-- Do not reset RM_Size if already set, as happens in the case -- Do not reset RM_Size if already set, as happens in the case of
-- of a modular type. -- a modular type.
if Unknown_Esize (PAT) then
Set_Esize (PAT, PASize); Set_Esize (PAT, PASize);
end if;
if Unknown_RM_Size (PAT) then if Unknown_RM_Size (PAT) then
Set_RM_Size (PAT, PASize); Set_RM_Size (PAT, PASize);
end if; end if;
Adjust_Esize_Alignment (PAT);
-- Set remaining fields of packed array type -- Set remaining fields of packed array type
Init_Alignment (PAT); Init_Alignment (PAT);
...@@ -874,7 +880,7 @@ package body Exp_Pakd is ...@@ -874,7 +880,7 @@ package body Exp_Pakd is
-- type, since this size clearly belongs to the packed array type. The -- type, since this size clearly belongs to the packed array type. The
-- size of the conceptual unpacked type is always set to unknown. -- size of the conceptual unpacked type is always set to unknown.
PASize := Esize (Typ); PASize := RM_Size (Typ);
-- Case of an array where at least one index is of an enumeration -- Case of an array where at least one index is of an enumeration
-- type with a non-standard representation, but the component size -- type with a non-standard representation, but the component size
...@@ -1144,15 +1150,13 @@ package body Exp_Pakd is ...@@ -1144,15 +1150,13 @@ package body Exp_Pakd is
-- range 0 .. 2 ** ((Typ'Length (1) -- range 0 .. 2 ** ((Typ'Length (1)
-- * ... * Typ'Length (n)) * Csize) - 1; -- * ... * Typ'Length (n)) * Csize) - 1;
-- The bounds are statically known, and btyp is one -- The bounds are statically known, and btyp is one of the
-- of the unsigned types, depending on the length. If the -- unsigned types, depending on the length.
-- type is its first subtype, i.e. it is a user-defined
-- type, no object of the type will be larger, and it is
-- worthwhile to use a small unsigned type.
if Len_Bits <= Standard_Short_Integer_Size if Len_Bits <= Standard_Short_Short_Integer_Size then
and then First_Subtype (Typ) = Typ Btyp := RTE (RE_Short_Short_Unsigned);
then
elsif Len_Bits <= Standard_Short_Integer_Size then
Btyp := RTE (RE_Short_Unsigned); Btyp := RTE (RE_Short_Unsigned);
elsif Len_Bits <= Standard_Integer_Size then elsif Len_Bits <= Standard_Integer_Size then
...@@ -2200,7 +2204,7 @@ package body Exp_Pakd is ...@@ -2200,7 +2204,7 @@ package body Exp_Pakd is
-- one bits of length equal to the size of this packed type and -- one bits of length equal to the size of this packed type and
-- rtyp is the actual subtype of the operand -- rtyp is the actual subtype of the operand
Lit := Make_Integer_Literal (Loc, 2 ** Esize (PAT) - 1); Lit := Make_Integer_Literal (Loc, 2 ** RM_Size (PAT) - 1);
Set_Print_In_Hex (Lit); Set_Print_In_Hex (Lit);
if not Is_Array_Type (PAT) then if not Is_Array_Type (PAT) then
......
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