Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                               C S T A N D                                --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-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- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- 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 COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Atree;    use Atree;

with Csets;    use Csets;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Layout;   use Layout;

with Namet;    use Namet;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Output;   use Output;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Ttypes;   use Ttypes;

with Ttypef;   use Ttypef;

with Scn;

with Sem_Mech; use Sem_Mech;

with Sem_Util; use Sem_Util;

with Sinfo;    use Sinfo;

with Snames;   use Snames;

with Stand;    use Stand;

with Uintp;    use Uintp;

with Urealp;   use Urealp;

package body CStand is

   Stloc  : constant Source_Ptr := Standard_Location;

   Staloc : constant Source_Ptr := Standard_ASCII_Location;

   --  Standard abbreviations used throughout this package

   -----------------------

   -- Local Subprograms --

   -----------------------

   procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int);

   --  Procedure to build standard predefined float base type. The first

   --  parameter is the entity for the type, and the second parameter

   --  is the size in bits. The third parameter is the digits value.

   procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int);

   --  Procedure to build standard predefined signed integer subtype. The

   --  first parameter is the entity for the subtype. The second parameter

   --  is the size in bits. The corresponding base type is not built by

   --  this routine but instead must be built by the caller where needed.

   procedure Create_Operators;

   --  Make entries for each of the predefined operators in Standard

   procedure Create_Unconstrained_Base_Type

     (E : Entity_Id;

      K : Entity_Kind);

   --  The predefined signed integer types are constrained subtypes which

   --  must have a corresponding unconstrained base type. This type is almost

   --  useless. The only place it has semantics is Subtypes_Statically_Match.

   --  Consequently, we arrange for it to be identical apart from the setting

   --  of the constrained bit. This routine takes an entity E for the Type,

   --  copies it to estabish the base type, then resets the Ekind of the

   --  original entity to K (the Ekind for the subtype). The Etype field of

   --  E is set by the call (to point to the created base type entity), and

   --  also the Is_Constrained flag of E is set.

   --

   --  To understand the exact requirement for this, see RM 3.5.4(11) which

   --  makes it clear that Integer, for example, is constrained, with the

   --  constraint bounds matching the bounds of the (unconstrained) base

   --  type. The point is that Integer and Integer'Base have identical

   --  bounds, but do not statically match, since a subtype with constraints

   --  never matches a subtype with no constraints.

   function Identifier_For (S : Standard_Entity_Type) return Node_Id;

   --  Returns an identifier node with the same name as the defining

   --  identifier corresponding to the given Standard_Entity_Type value

   procedure Make_Component

     (Rec : Entity_Id;

      Typ : Entity_Id;

      Nam : String);

   --  Build a record component with the given type and name, and append to

   --  the list of components of Rec.

   function Make_Formal

     (Typ         : Entity_Id;

      Formal_Name : String) return Entity_Id;

   --  Construct entity for subprogram formal with given name and type

   function Make_Integer (V : Uint) return Node_Id;

   --  Builds integer literal with given value

   procedure Make_Name (Id : Entity_Id; Nam : String);

   --  Make an entry in the names table for Nam, and set as Chars field of Id

   function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id;

   --  Build entity for standard operator with given name and type

   function New_Standard_Entity

     (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;

   --  Builds a new entity for Standard

   procedure Print_Standard;

   --  Print representation of package Standard if switch set

   procedure Set_Integer_Bounds

     (Id  : Entity_Id;

      Typ : Entity_Id;

      Lb  : Uint;

      Hb  : Uint);

   --  Procedure to set bounds for integer type or subtype. Id is the entity

   --  whose bounds and type are to be set. The Typ parameter is the Etype

   --  value for the entity (which will be the same as Id for all predefined

   --  integer base types. The third and fourth parameters are the bounds.

   ----------------------

   -- Build_Float_Type --

   ----------------------

   procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int) is

   begin

      Set_Type_Definition (Parent (E),

        Make_Floating_Point_Definition (Stloc,

          Digits_Expression => Make_Integer (UI_From_Int (Digs))));

      Set_Ekind                      (E, E_Floating_Point_Type);

      Set_Etype                      (E, E);

      Init_Size                      (E, Siz);

      Set_Elem_Alignment             (E);

      Init_Digits_Value              (E, Digs);

      Set_Float_Bounds               (E);

      Set_Is_Frozen                  (E);

      Set_Is_Public                  (E);

      Set_Size_Known_At_Compile_Time (E);

   end Build_Float_Type;

   -------------------------------

   -- Build_Signed_Integer_Type --

   -------------------------------

   procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int) is

      U2Siz1 : constant Uint := 2 ** (Siz - 1);

      Lbound : constant Uint := -U2Siz1;

      Ubound : constant Uint := U2Siz1 - 1;

   begin

      Set_Type_Definition (Parent (E),

        Make_Signed_Integer_Type_Definition (Stloc,

          Low_Bound  => Make_Integer (Lbound),

          High_Bound => Make_Integer (Ubound)));

      Set_Ekind                      (E, E_Signed_Integer_Type);

      Set_Etype                      (E, E);

      Init_Size                      (E, Siz);

      Set_Elem_Alignment             (E);

      Set_Integer_Bounds             (E, E, Lbound, Ubound);

      Set_Is_Frozen                  (E);

      Set_Is_Public                  (E);

      Set_Is_Known_Valid             (E);

      Set_Size_Known_At_Compile_Time (E);

   end Build_Signed_Integer_Type;

   ----------------------

   -- Create_Operators --

   ----------------------

   --  Each operator has an abbreviated signature. The formals have the names

   --  LEFT and RIGHT. Their types are not actually used for resolution.

   procedure Create_Operators is

      Op_Node : Entity_Id;

      --  The following tables define the binary and unary operators and their

      --  corresponding result type.

      Binary_Ops : constant array (S_Binary_Ops) of Name_Id :=

         --  There is one entry here for each binary operator, except for the

         --  case of concatenation, where there are three entries, one for a

         --  String result, one for Wide_String, and one for Wide_Wide_String.

        (Name_Op_Add,

         Name_Op_And,

         Name_Op_Concat,

         Name_Op_Concat,

         Name_Op_Concat,

         Name_Op_Divide,

         Name_Op_Eq,

         Name_Op_Expon,

         Name_Op_Ge,

         Name_Op_Gt,

         Name_Op_Le,

         Name_Op_Lt,

         Name_Op_Mod,

         Name_Op_Multiply,

         Name_Op_Ne,

         Name_Op_Or,

         Name_Op_Rem,

         Name_Op_Subtract,

         Name_Op_Xor);

      Bin_Op_Types : constant array (S_Binary_Ops) of Entity_Id :=

         --  This table has the corresponding result types. The entries are

         --  ordered so they correspond to the Binary_Ops array above.

        (Universal_Integer,         -- Add

         Standard_Boolean,          -- And

         Standard_String,           -- Concat (String)

         Standard_Wide_String,      -- Concat (Wide_String)

         Standard_Wide_Wide_String, -- Concat (Wide_Wide_String)

         Universal_Integer,         -- Divide

         Standard_Boolean,          -- Eq

         Universal_Integer,         -- Expon

         Standard_Boolean,          -- Ge

         Standard_Boolean,          -- Gt

         Standard_Boolean,          -- Le

         Standard_Boolean,          -- Lt

         Universal_Integer,         -- Mod

         Universal_Integer,         -- Multiply

         Standard_Boolean,          -- Ne

         Standard_Boolean,          -- Or

         Universal_Integer,         -- Rem

         Universal_Integer,         -- Subtract

         Standard_Boolean);         -- Xor

      Unary_Ops : constant array (S_Unary_Ops) of Name_Id :=

         --  There is one entry here for each unary operator

        (Name_Op_Abs,

         Name_Op_Subtract,

         Name_Op_Not,

         Name_Op_Add);

      Unary_Op_Types : constant array (S_Unary_Ops) of Entity_Id :=

         --  This table has the corresponding result types. The entries are

         --  ordered so they correspond to the Unary_Ops array above.

        (Universal_Integer,     -- Abs

         Universal_Integer,     -- Subtract

         Standard_Boolean,      -- Not

         Universal_Integer);    -- Add

   begin

      for J in S_Binary_Ops loop

         Op_Node := New_Operator (Binary_Ops (J), Bin_Op_Types (J));

         SE (J)  := Op_Node;

         Append_Entity (Make_Formal (Any_Type, "LEFT"),  Op_Node);

         Append_Entity (Make_Formal (Any_Type, "RIGHT"), Op_Node);

      end loop;

      for J in S_Unary_Ops loop

         Op_Node := New_Operator (Unary_Ops (J), Unary_Op_Types (J));

         SE (J)  := Op_Node;

         Append_Entity (Make_Formal (Any_Type, "RIGHT"), Op_Node);

      end loop;

      --  For concatenation, we create a separate operator for each

      --  array type. This simplifies the resolution of the component-

      --  component concatenation operation. In Standard, we set the types

      --  of the formals for string, wide [wide]_string, concatenations.

      Set_Etype (First_Entity (Standard_Op_Concat),  Standard_String);

      Set_Etype (Last_Entity  (Standard_Op_Concat),  Standard_String);

      Set_Etype (First_Entity (Standard_Op_Concatw), Standard_Wide_String);

      Set_Etype (Last_Entity  (Standard_Op_Concatw), Standard_Wide_String);

      Set_Etype (First_Entity (Standard_Op_Concatww),

                  Standard_Wide_Wide_String);

      Set_Etype (Last_Entity (Standard_Op_Concatww),

                   Standard_Wide_Wide_String);

   end Create_Operators;

   ---------------------

   -- Create_Standard --

   ---------------------

   --  The tree for the package Standard is prefixed to all compilations.

   --  Several entities required by semantic analysis are denoted by global

   --  variables that are initialized to point to the corresponding

   --  occurrences in STANDARD. The visible entities of STANDARD are

   --  created here. The private entities defined in STANDARD are created

   --  by Initialize_Standard in the semantics module.

   procedure Create_Standard is

      Decl_S : constant List_Id := New_List;

      --  List of declarations in Standard

      Decl_A : constant List_Id := New_List;

      --  List of declarations in ASCII

      Decl       : Node_Id;

      Pspec      : Node_Id;

      Tdef_Node  : Node_Id;

      Ident_Node : Node_Id;

      Ccode      : Char_Code;

      E_Id       : Entity_Id;

      R_Node     : Node_Id;

      B_Node     : Node_Id;

      procedure Build_Exception (S : Standard_Entity_Type);

      --  Procedure to declare given entity as an exception

      ---------------------

      -- Build_Exception --

      ---------------------

      procedure Build_Exception (S : Standard_Entity_Type) is

      begin

         Set_Ekind          (Standard_Entity (S), E_Exception);

         Set_Etype          (Standard_Entity (S), Standard_Exception_Type);

         Set_Exception_Code (Standard_Entity (S), Uint_0);

         Set_Is_Public      (Standard_Entity (S), True);

         Decl :=

           Make_Exception_Declaration (Stloc,

             Defining_Identifier => Standard_Entity (S));

         Append (Decl, Decl_S);

      end Build_Exception;

   --  Start of processing for Create_Standard

   begin

      --  Initialize scanner for internal scans of literals

      Scn.Initialize_Scanner (No_Unit, Internal_Source_File);

      --  First step is to create defining identifiers for each entity

      for S in Standard_Entity_Type loop

         declare

            S_Name : constant String := Standard_Entity_Type'Image (S);

            --  Name of entity (note we skip S_ at the start)

            Ident_Node : Node_Id;

            --  Defining identifier node

         begin

            Ident_Node := New_Standard_Entity;

            Make_Name (Ident_Node, S_Name (3 .. S_Name'Length));

            Standard_Entity (S) := Ident_Node;

         end;

      end loop;

      --  Create package declaration node for package Standard

      Standard_Package_Node := New_Node (N_Package_Declaration, Stloc);

      Pspec := New_Node (N_Package_Specification, Stloc);

      Set_Specification (Standard_Package_Node, Pspec);

      Set_Defining_Unit_Name (Pspec, Standard_Standard);

      Set_Visible_Declarations (Pspec, Decl_S);

      Set_Ekind (Standard_Standard, E_Package);

      Set_Is_Pure (Standard_Standard);

      Set_Is_Compilation_Unit (Standard_Standard);

      --  Create type/subtype declaration nodes for standard types

      for S in S_Types loop

         --  Subtype declaration case

         if S = S_Natural or else S = S_Positive then

            Decl := New_Node (N_Subtype_Declaration, Stloc);

            Set_Subtype_Indication (Decl,

              New_Occurrence_Of (Standard_Integer, Stloc));

         --  Full type declaration case

         else

            Decl := New_Node (N_Full_Type_Declaration, Stloc);

         end if;

         Set_Is_Frozen (Standard_Entity (S));

         Set_Is_Public (Standard_Entity (S));

         Set_Defining_Identifier (Decl, Standard_Entity (S));

         Append (Decl, Decl_S);

      end loop;

      --  Create type definition node for type Boolean. The Size is set to

      --  1 as required by Ada 95 and current ARG interpretations for Ada/83.

      --  Note: Object_Size of Boolean is 8. This means that we do NOT in

      --  general know that Boolean variables have valid values, so we do

      --  not set the Is_Known_Valid flag.

      Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);

      Set_Literals (Tdef_Node, New_List);

      Append (Standard_False, Literals (Tdef_Node));

      Append (Standard_True, Literals (Tdef_Node));

      Set_Type_Definition (Parent (Standard_Boolean), Tdef_Node);

      Set_Ekind          (Standard_Boolean, E_Enumeration_Type);

      Set_First_Literal  (Standard_Boolean, Standard_False);

      Set_Etype          (Standard_Boolean, Standard_Boolean);

      Init_Esize         (Standard_Boolean, Standard_Character_Size);

      Init_RM_Size       (Standard_Boolean, 1);

      Set_Elem_Alignment (Standard_Boolean);

      Set_Is_Unsigned_Type           (Standard_Boolean);

      Set_Size_Known_At_Compile_Time (Standard_Boolean);

      Set_Ekind           (Standard_True, E_Enumeration_Literal);

      Set_Etype           (Standard_True, Standard_Boolean);

      Set_Enumeration_Pos (Standard_True, Uint_1);

      Set_Enumeration_Rep (Standard_True, Uint_1);

      Set_Is_Known_Valid  (Standard_True, True);

      Set_Ekind           (Standard_False, E_Enumeration_Literal);

      Set_Etype           (Standard_False, Standard_Boolean);

      Set_Enumeration_Pos (Standard_False, Uint_0);

      Set_Enumeration_Rep (Standard_False, Uint_0);

      Set_Is_Known_Valid  (Standard_False, True);

      --  For the bounds of Boolean, we create a range node corresponding to

      --    range False .. True

      --  where the occurrences of the literals must point to the

      --  corresponding definition.

      R_Node := New_Node (N_Range, Stloc);

      B_Node := New_Node (N_Identifier, Stloc);

      Set_Chars  (B_Node, Chars (Standard_False));

      Set_Entity (B_Node,  Standard_False);

      Set_Etype  (B_Node, Standard_Boolean);

      Set_Is_Static_Expression (B_Node);

      Set_Low_Bound  (R_Node, B_Node);

      B_Node := New_Node (N_Identifier, Stloc);

      Set_Chars  (B_Node, Chars (Standard_True));

      Set_Entity (B_Node,  Standard_True);

      Set_Etype  (B_Node, Standard_Boolean);

      Set_Is_Static_Expression (B_Node);

      Set_High_Bound (R_Node, B_Node);

      Set_Scalar_Range (Standard_Boolean, R_Node);

      Set_Etype (R_Node, Standard_Boolean);

      Set_Parent (R_Node, Standard_Boolean);

      --  Record entity identifiers for boolean literals in the

      --  Boolean_Literals array, for easy reference during expansion.

      Boolean_Literals := (False => Standard_False, True => Standard_True);

      --  Create type definition nodes for predefined integer types

      Build_Signed_Integer_Type

        (Standard_Short_Short_Integer, Standard_Short_Short_Integer_Size);

      Build_Signed_Integer_Type

        (Standard_Short_Integer, Standard_Short_Integer_Size);

      Build_Signed_Integer_Type

        (Standard_Integer, Standard_Integer_Size);

      declare

         LIS : Nat;

      begin

         if Debug_Flag_M then

            LIS := 64;

         else

            LIS := Standard_Long_Integer_Size;

         end if;

         Build_Signed_Integer_Type (Standard_Long_Integer, LIS);

      end;

      Build_Signed_Integer_Type

        (Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size);

      Create_Unconstrained_Base_Type

        (Standard_Short_Short_Integer, E_Signed_Integer_Subtype);

      Create_Unconstrained_Base_Type

        (Standard_Short_Integer, E_Signed_Integer_Subtype);

      Create_Unconstrained_Base_Type

        (Standard_Integer, E_Signed_Integer_Subtype);

      Create_Unconstrained_Base_Type

        (Standard_Long_Integer, E_Signed_Integer_Subtype);

      Create_Unconstrained_Base_Type

        (Standard_Long_Long_Integer, E_Signed_Integer_Subtype);

      --  Create type definition nodes for predefined float types

      Build_Float_Type

        (Standard_Short_Float,

         Standard_Short_Float_Size,

         Standard_Short_Float_Digits);

      Build_Float_Type

        (Standard_Float,

         Standard_Float_Size,

         Standard_Float_Digits);

      Build_Float_Type

        (Standard_Long_Float,

         Standard_Long_Float_Size,

         Standard_Long_Float_Digits);

      Build_Float_Type

        (Standard_Long_Long_Float,

         Standard_Long_Long_Float_Size,

         Standard_Long_Long_Float_Digits);

      --  Create type definition node for type Character. Note that we do not

      --  set the Literals field, since type Character is handled with special

      --  routine that do not need a literal list.

      Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);

      Set_Type_Definition (Parent (Standard_Character), Tdef_Node);

      Set_Ekind          (Standard_Character, E_Enumeration_Type);

      Set_Etype          (Standard_Character, Standard_Character);

      Init_Esize         (Standard_Character, Standard_Character_Size);

      Init_RM_Size       (Standard_Character, 8);

      Set_Elem_Alignment (Standard_Character);

      Set_Is_Unsigned_Type           (Standard_Character);

      Set_Is_Character_Type          (Standard_Character);

      Set_Is_Known_Valid             (Standard_Character);

      Set_Size_Known_At_Compile_Time (Standard_Character);

      --  Create the bounds for type Character

      R_Node := New_Node (N_Range, Stloc);

      --  Low bound for type Character (Standard.Nul)

      B_Node := New_Node (N_Character_Literal, Stloc);

      Set_Is_Static_Expression (B_Node);

      Set_Chars                (B_Node, No_Name);

      Set_Char_Literal_Value   (B_Node, Uint_0);

      Set_Entity               (B_Node, Empty);

      Set_Etype                (B_Node, Standard_Character);

      Set_Low_Bound (R_Node, B_Node);

      --  High bound for type Character

      B_Node := New_Node (N_Character_Literal, Stloc);

      Set_Is_Static_Expression (B_Node);

      Set_Chars                (B_Node, No_Name);

      Set_Char_Literal_Value   (B_Node, UI_From_Int (16#FF#));

      Set_Entity               (B_Node, Empty);

      Set_Etype                (B_Node, Standard_Character);

      Set_High_Bound (R_Node, B_Node);

      Set_Scalar_Range (Standard_Character, R_Node);

      Set_Etype (R_Node, Standard_Character);

      Set_Parent (R_Node, Standard_Character);

      --  Create type definition for type Wide_Character. Note that we do not

      --  set the Literals field, since type Wide_Character is handled with

      --  special routines that do not need a literal list.

      Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);

      Set_Type_Definition (Parent (Standard_Wide_Character), Tdef_Node);

      Set_Ekind      (Standard_Wide_Character, E_Enumeration_Type);

      Set_Etype      (Standard_Wide_Character, Standard_Wide_Character);

      Init_Size      (Standard_Wide_Character, Standard_Wide_Character_Size);

      Set_Elem_Alignment             (Standard_Wide_Character);

      Set_Is_Unsigned_Type           (Standard_Wide_Character);

      Set_Is_Character_Type          (Standard_Wide_Character);

      Set_Is_Known_Valid             (Standard_Wide_Character);

      Set_Size_Known_At_Compile_Time (Standard_Wide_Character);

      --  Create the bounds for type Wide_Character

      R_Node := New_Node (N_Range, Stloc);

      --  Low bound for type Wide_Character

      B_Node := New_Node (N_Character_Literal, Stloc);

      Set_Is_Static_Expression (B_Node);

      Set_Chars                (B_Node, No_Name);    --  ???

      Set_Char_Literal_Value   (B_Node, Uint_0);

      Set_Entity               (B_Node, Empty);

      Set_Etype                (B_Node, Standard_Wide_Character);

      Set_Low_Bound (R_Node, B_Node);

      --  High bound for type Wide_Character

      B_Node := New_Node (N_Character_Literal, Stloc);

      Set_Is_Static_Expression (B_Node);

      Set_Chars                (B_Node, No_Name);    --  ???

      Set_Char_Literal_Value   (B_Node, UI_From_Int (16#FFFF#));

      Set_Entity               (B_Node, Empty);

      Set_Etype                (B_Node, Standard_Wide_Character);

      Set_High_Bound           (R_Node, B_Node);

      Set_Scalar_Range (Standard_Wide_Character, R_Node);

      Set_Etype (R_Node, Standard_Wide_Character);

      Set_Parent (R_Node, Standard_Wide_Character);

      --  Create type definition for type Wide_Wide_Character. Note that we

      --  do not set the Literals field, since type Wide_Wide_Character is

      --  handled with special routines that do not need a literal list.

      Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);

      Set_Type_Definition (Parent (Standard_Wide_Wide_Character), Tdef_Node);

      Set_Ekind (Standard_Wide_Wide_Character, E_Enumeration_Type);

      Set_Etype (Standard_Wide_Wide_Character,

                 Standard_Wide_Wide_Character);

      Init_Size (Standard_Wide_Wide_Character,

                 Standard_Wide_Wide_Character_Size);

      Set_Elem_Alignment             (Standard_Wide_Wide_Character);

      Set_Is_Unsigned_Type           (Standard_Wide_Wide_Character);

      Set_Is_Character_Type          (Standard_Wide_Wide_Character);

      Set_Is_Known_Valid             (Standard_Wide_Wide_Character);

      Set_Size_Known_At_Compile_Time (Standard_Wide_Wide_Character);

      Set_Is_Ada_2005_Only           (Standard_Wide_Wide_Character);

      --  Create the bounds for type Wide_Wide_Character

      R_Node := New_Node (N_Range, Stloc);

      --  Low bound for type Wide_Wide_Character

      B_Node := New_Node (N_Character_Literal, Stloc);

      Set_Is_Static_Expression (B_Node);

      Set_Chars                (B_Node, No_Name);    --  ???

      Set_Char_Literal_Value   (B_Node, Uint_0);

      Set_Entity               (B_Node, Empty);

      Set_Etype                (B_Node, Standard_Wide_Wide_Character);

      Set_Low_Bound (R_Node, B_Node);

      --  High bound for type Wide_Wide_Character

      B_Node := New_Node (N_Character_Literal, Stloc);

      Set_Is_Static_Expression (B_Node);

      Set_Chars                (B_Node, No_Name);    --  ???

      Set_Char_Literal_Value   (B_Node, UI_From_Int (16#7FFF_FFFF#));

      Set_Entity               (B_Node, Empty);

      Set_Etype                (B_Node, Standard_Wide_Wide_Character);

      Set_High_Bound           (R_Node, B_Node);

      Set_Scalar_Range (Standard_Wide_Wide_Character, R_Node);

      Set_Etype (R_Node, Standard_Wide_Wide_Character);

      Set_Parent (R_Node, Standard_Wide_Wide_Character);

      --  Create type definition node for type String

      Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);

      declare

         CompDef_Node : Node_Id;

      begin

         CompDef_Node := New_Node (N_Component_Definition, Stloc);

         Set_Aliased_Present      (CompDef_Node, False);

         Set_Access_Definition    (CompDef_Node, Empty);

         Set_Subtype_Indication   (CompDef_Node, Identifier_For (S_Character));

         Set_Component_Definition (Tdef_Node, CompDef_Node);

      end;

      Set_Subtype_Marks      (Tdef_Node, New_List);

      Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));

      Set_Type_Definition (Parent (Standard_String), Tdef_Node);

      Set_Ekind          (Standard_String, E_String_Type);

      Set_Etype          (Standard_String, Standard_String);

      Set_Component_Type (Standard_String, Standard_Character);

      Set_Component_Size (Standard_String, Uint_8);

      Init_Size_Align    (Standard_String);

      Set_Alignment      (Standard_String, Uint_1);

      --  On targets where a storage unit is larger than a byte (such as AAMP),

      --  pragma Pack has a real effect on the representation of type String,

      --  and the type must be marked as having a nonstandard representation.

      if System_Storage_Unit > Uint_8 then

         Set_Has_Non_Standard_Rep (Standard_String);

         Set_Has_Pragma_Pack      (Standard_String);

      end if;

      --  Set index type of String

      E_Id := First

        (Subtype_Marks (Type_Definition (Parent (Standard_String))));

      Set_First_Index (Standard_String, E_Id);

      Set_Entity (E_Id, Standard_Positive);

      Set_Etype (E_Id, Standard_Positive);

      --  Create type definition node for type Wide_String

      Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);

      declare

         CompDef_Node : Node_Id;

      begin

         CompDef_Node := New_Node (N_Component_Definition, Stloc);

         Set_Aliased_Present    (CompDef_Node, False);

         Set_Access_Definition  (CompDef_Node, Empty);

         Set_Subtype_Indication (CompDef_Node,

                                 Identifier_For (S_Wide_Character));

         Set_Component_Definition (Tdef_Node, CompDef_Node);

      end;

      Set_Subtype_Marks (Tdef_Node, New_List);

      Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));

      Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);

      Set_Ekind          (Standard_Wide_String, E_String_Type);

      Set_Etype          (Standard_Wide_String, Standard_Wide_String);

      Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);

      Set_Component_Size (Standard_Wide_String, Uint_16);

      Init_Size_Align    (Standard_Wide_String);

      --  Set index type of Wide_String

      E_Id := First

        (Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));

      Set_First_Index (Standard_Wide_String, E_Id);

      Set_Entity (E_Id, Standard_Positive);

      Set_Etype (E_Id, Standard_Positive);

      --  Create type definition node for type Wide_Wide_String

      Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);

      declare

         CompDef_Node : Node_Id;

      begin

         CompDef_Node := New_Node (N_Component_Definition, Stloc);

         Set_Aliased_Present    (CompDef_Node, False);

         Set_Access_Definition  (CompDef_Node, Empty);

         Set_Subtype_Indication (CompDef_Node,

                                 Identifier_For (S_Wide_Wide_Character));

         Set_Component_Definition (Tdef_Node, CompDef_Node);

      end;

      Set_Subtype_Marks (Tdef_Node, New_List);

      Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));

      Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);

      Set_Ekind            (Standard_Wide_Wide_String, E_String_Type);

      Set_Etype            (Standard_Wide_Wide_String,

                            Standard_Wide_Wide_String);

      Set_Component_Type   (Standard_Wide_Wide_String,

                            Standard_Wide_Wide_Character);

      Set_Component_Size   (Standard_Wide_Wide_String, Uint_32);

      Init_Size_Align      (Standard_Wide_Wide_String);

      Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);

      --  Set index type of Wide_Wide_String

      E_Id := First

        (Subtype_Marks (Type_Definition (Parent (Standard_Wide_Wide_String))));

      Set_First_Index (Standard_Wide_Wide_String, E_Id);

      Set_Entity (E_Id, Standard_Positive);

      Set_Etype (E_Id, Standard_Positive);

      --  Setup entity for Naturalend Create_Standard;

      Set_Ekind          (Standard_Natural, E_Signed_Integer_Subtype);

      Set_Etype          (Standard_Natural, Base_Type (Standard_Integer));

      Init_Esize         (Standard_Natural, Standard_Integer_Size);

      Init_RM_Size       (Standard_Natural, Standard_Integer_Size - 1);