-- --
-- B o d y --
-- --
--- $Revision$
--- --
--- Copyright (C) 2001 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2005 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- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Nmake; use Nmake;
with Nlists; use Nlists;
-with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem_Res; use Sem_Res;
with Sinfo; use Sinfo;
Eind :=
Make_Defining_Identifier (Loc,
- Chars => New_External_Name (Chars (E), 'I'));
+ Chars => New_External_Name (Chars (E), 'N'));
Set_Lit_Strings (E, Estr);
Set_Lit_Indexes (E, Eind);
Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 0),
High_Bound => Make_Integer_Literal (Loc, Nlit))),
- Subtype_Indication => New_Occurrence_Of (Ityp, Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Occurrence_Of (Ityp, Loc))),
Expression =>
Make_Aggregate (Loc,
-- For types whose root type is Wide_Character
-- xx = Wide_Character
-- tv = Wide_Character (Expr)
- -- pm = Wide_Character_Encoding_Method
+
+ -- For types whose root type is Wide_Wide_Character
+ -- xx = Wide_Wide_haracter
+ -- tv = Wide_Wide_Character (Expr)
-- For floating-point types
-- xx = Floating_Point
Imid := RE_Image_Wide_Character;
Tent := Rtyp;
+ elsif Rtyp = Standard_Wide_Wide_Character then
+ Imid := RE_Image_Wide_Wide_Character;
+ Tent := Rtyp;
+
elsif Is_Signed_Integer_Type (Rtyp) then
if Esize (Rtyp) <= Esize (Standard_Integer) then
Imid := RE_Image_Integer;
Prefix => New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_Aft));
- -- For wide character, append encoding method
-
- elsif Rtyp = Standard_Wide_Character then
- Append_To (Arglist,
- Make_Integer_Literal (Loc,
- Intval => Int (Wide_Character_Encoding_Method)));
-
-- For decimal, append Scale and also set to do literal conversion
elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
-- For types whose root type is Character
-- xx = Character
+ -- For types whose root type is Wide_Character
+ -- xx = Wide_Character
+
+ -- For types whose root type is Wide_Wide_Character
+ -- xx = Wide_Wide_Character
+
-- For types whose root type is Boolean
-- xx = Boolean
-- For floating-point types and ordinary fixed-point types
-- xx = Real
- -- For types derived from Wide_Character, typ'Value (X) expands into
-
- -- Value_Wide_Character (X, Wide_Character_Encoding_Method)
-
-- For decimal types with size <= Integer'Size, typ'Value (X)
-- expands into
-- btyp?(Value_Long_Long_Decimal (X, typ'Scale))
-- For enumeration types other than those derived from types Boolean,
- -- Character, and Wide_Character in Standard, typ'Value (X) expands to:
+ -- Character, Wide_[Wide_]Character in Standard, typ'Value (X) expands to:
-- Enum'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
elsif Rtyp = Standard_Wide_Character then
Vid := RE_Value_Wide_Character;
- Append_To (Args,
- Make_Integer_Literal (Loc,
- Intval => Int (Wide_Character_Encoding_Method)));
+
+ elsif Rtyp = Standard_Wide_Wide_Character then
+ Vid := RE_Value_Wide_Wide_Character;
elsif Rtyp = Base_Type (Standard_Short_Short_Integer)
or else Rtyp = Base_Type (Standard_Short_Integer)
-- Expand_Width_Attribute --
----------------------------
- -- The processing here also handles the case of Wide_Width. With the
+ -- The processing here also handles the case of Wide_[Wide_]Width. With the
-- exceptions noted, the processing is identical
-- For scalar types derived from Boolean, character and integer types
-- in package Standard. Note that the Width attribute is computed at
-- compile time for all cases except those involving non-static sub-
- -- types. For such subtypes, typ'Width and typ'Wide_Width expands into:
+ -- types. For such subtypes, typ'[Wide_[Wide_]]Width expands into:
-- Result_Type (xx (yy (Ptyp'First), yy (Ptyp'Last)))
-- where
-- For types whose root type is Character
- -- xx = Width_Character (Wide_Width_Character for Wide_Width case)
+ -- xx = Width_Character
+ -- yy = Character
+
+ -- For types whose root type is Wide_Character
+ -- xx = Wide_Width_Character
+ -- yy = Character
+
+ -- For types whose root type is Wide_Wide_Character
+ -- xx = Wide_Wide_Width_Character
-- yy = Character
-- For types whose root type is Boolean
-- Result_Type (Width_Wide_Character (
-- Wide_Character (typ'First),
-- Wide_Character (typ'Last),
- -- Wide_Character_Encoding_Method);
-- and typ'Wide_Width expands into:
-- Wide_Character (typ'First),
-- Wide_Character (typ'Last));
- -- For real types, typ'Width and typ'Wide_Width expand into
+ -- and typ'Wide_Wide_Width expands into
+
+ -- Result_Type (Wide_Wide_Width_Wide_Character (
+ -- Wide_Character (typ'First),
+ -- Wide_Character (typ'Last));
+
+ -- For types derived from Wide_Wide_Character, typ'Width expands into
+
+ -- Result_Type (Width_Wide_Wide_Character (
+ -- Wide_Wide_Character (typ'First),
+ -- Wide_Wide_Character (typ'Last),
+
+ -- and typ'Wide_Width expands into:
+
+ -- Result_Type (Wide_Width_Wide_Wide_Character (
+ -- Wide_Wide_Character (typ'First),
+ -- Wide_Wide_Character (typ'Last));
+
+ -- and typ'Wide_Wide_Width expands into
+
+ -- Result_Type (Wide_Wide_Width_Wide_Wide_Char (
+ -- Wide_Wide_Character (typ'First),
+ -- Wide_Wide_Character (typ'Last));
+
+ -- For real types, typ'Width and typ'Wide_[Wide_]Width expand into
-- if Ptyp'First > Ptyp'Last then 0 else btyp'Width end if
-- typ'Pos (Typ'Last))
-- Wide_Character_Encoding_Method);
+ -- and typ'Wide_Wide_Width expands into:
+
+ -- Result_Type (Wide_Wide_Width_Enumeration_NN
+ -- (typS,
+ -- typI,
+ -- typ'Pos (typ'First),
+ -- typ'Pos (Typ'Last))
+ -- Wide_Character_Encoding_Method);
+
-- where typS and typI are the enumeration image strings and
-- indexes table, as described in Build_Enumeration_Image_Tables.
-- NN is 8/16/32 for depending on the element type for typI.
- procedure Expand_Width_Attribute (N : Node_Id; Wide : Boolean) is
+ procedure Expand_Width_Attribute (N : Node_Id; Attr : Atype := Normal) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Pref : constant Node_Id := Prefix (N);
-- Types derived from Standard.Character
elsif Rtyp = Standard_Character then
- if not Wide then
- XX := RE_Width_Character;
- else
- XX := RE_Wide_Width_Character;
- end if;
+ case Attr is
+ when Normal => XX := RE_Width_Character;
+ when Wide => XX := RE_Wide_Width_Character;
+ when Wide_Wide => XX := RE_Wide_Wide_Width_Character;
+ end case;
YY := Rtyp;
-- Types derived from Standard.Wide_Character
elsif Rtyp = Standard_Wide_Character then
- if not Wide then
- XX := RE_Width_Wide_Character;
- else
- XX := RE_Wide_Width_Wide_Character;
- end if;
+ case Attr is
+ when Normal => XX := RE_Width_Wide_Character;
+ when Wide => XX := RE_Wide_Width_Wide_Character;
+ when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Character;
+ end case;
+
+ YY := Rtyp;
+
+ -- Types derived from Standard.Wide_Wide_Character
+
+ elsif Rtyp = Standard_Wide_Wide_Character then
+ case Attr is
+ when Normal => XX := RE_Width_Wide_Wide_Character;
+ when Wide => XX := RE_Wide_Width_Wide_Wide_Character;
+ when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Wide_Char;
+ end case;
YY := Rtyp;
Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
- if not Wide then
- if Ttyp = Standard_Integer_8 then
- XX := RE_Width_Enumeration_8;
- elsif Ttyp = Standard_Integer_16 then
- XX := RE_Width_Enumeration_16;
- else
- XX := RE_Width_Enumeration_32;
- end if;
-
- else
- if Ttyp = Standard_Integer_8 then
- XX := RE_Wide_Width_Enumeration_8;
- elsif Ttyp = Standard_Integer_16 then
- XX := RE_Wide_Width_Enumeration_16;
- else
- XX := RE_Wide_Width_Enumeration_32;
- end if;
- end if;
+ case Attr is
+ when Normal =>
+ if Ttyp = Standard_Integer_8 then
+ XX := RE_Width_Enumeration_8;
+ elsif Ttyp = Standard_Integer_16 then
+ XX := RE_Width_Enumeration_16;
+ else
+ XX := RE_Width_Enumeration_32;
+ end if;
+
+ when Wide =>
+ if Ttyp = Standard_Integer_8 then
+ XX := RE_Wide_Width_Enumeration_8;
+ elsif Ttyp = Standard_Integer_16 then
+ XX := RE_Wide_Width_Enumeration_16;
+ else
+ XX := RE_Wide_Width_Enumeration_32;
+ end if;
+
+ when Wide_Wide =>
+ if Ttyp = Standard_Integer_8 then
+ XX := RE_Wide_Wide_Width_Enumeration_8;
+ elsif Ttyp = Standard_Integer_16 then
+ XX := RE_Wide_Wide_Width_Enumeration_16;
+ else
+ XX := RE_Wide_Wide_Width_Enumeration_32;
+ end if;
+ end case;
Arglist :=
New_List (
Prefix => New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_Last))));
- -- For enumeration'Wide_Width, add encoding method parameter
-
- if Wide then
- Append_To (Arglist,
- Make_Integer_Literal (Loc,
- Intval => Int (Wide_Character_Encoding_Method)));
- end if;
-
Rewrite (N,
Convert_To (Typ,
Make_Function_Call (Loc,
Prefix => New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_Last)));
- -- For Wide_Character'Width, add encoding method parameter
-
- if Rtyp = Standard_Wide_Character and then Wide then
- Append_To (Arglist,
- Make_Integer_Literal (Loc,
- Intval => Int (Wide_Character_Encoding_Method)));
- end if;
-
Rewrite (N,
Convert_To (Typ,
Make_Function_Call (Loc,
OSDN Git Service
