Subversion Repositories openrisc

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                               C S T A N D                                --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2011, 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 Back_End; use Back_End;

with Csets;    use Csets;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

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 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

   Back_End_Float_Types : Elist_Id := No_Elist;

   --  List used for any floating point supported by the back end. This needs

   --  to be at the library level, because the call back procedures retrieving

   --  this information are at that level.

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

   -- Local Subprograms --

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

   procedure Build_Float_Type

     (E    : Entity_Id;

      Siz  : Int;

      Rep  : Float_Rep_Kind;

      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 indicates the kind of representation

   --  to be used. The fourth parameter is the digits value. Each type

   --  is added to the list of predefined floating point types.

   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 Copy_Float_Type (To : Entity_Id; From : Entity_Id);

   --  Build a floating point type, copying representation details from From.

   --  This is used to create predefined floating point types based on

   --  available types in the back end.

   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 Find_Back_End_Float_Type (Name : String) return Entity_Id;

   --  Return the first float type in Back_End_Float_Types with the given name.

   --  Names of entities in back end types, are either type names of C

   --  predefined types (all lower case), or mode names (upper case).

   --  These are not generally valid identifier names.

   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 Register_Float_Type

     (Name      : C_String; -- Nul-terminated string with name of type

      Digs      : Natural;  -- Nr or digits for floating point, 0 otherwise

      Complex   : Boolean;  -- True iff type has real and imaginary parts

      Count     : Natural;  -- Number of elements in vector, 0 otherwise

      Float_Rep : Float_Rep_Kind; -- Representation used for fpt type

      Size      : Positive; -- Size of representation in bits

      Alignment : Natural); -- Required alignment in bits

   pragma Convention (C, Register_Float_Type);

   --  Call back to allow the back end to register available types.

   --  This call back currently creates predefined floating point base types

   --  for any floating point types reported by the back end, and adds them

   --  to the list of predefined float types.

   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;

      Rep  : Float_Rep_Kind;

      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);

      Set_Float_Rep (E, Rep);

      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;

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

   -- Find_Back_End_Float_Type --

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

   function Find_Back_End_Float_Type (Name : String) return Entity_Id is

      N : Elmt_Id;

   begin

      N := First_Elmt (Back_End_Float_Types);

      while Present (N) and then Get_Name_String (Chars (Node (N))) /= Name

      loop

         Next_Elmt (N);

      end loop;

      return Node (N);

   end Find_Back_End_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;

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

   -- Copy_Float_Type --

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

   procedure Copy_Float_Type (To : Entity_Id; From : Entity_Id) is

   begin

      Build_Float_Type (To, UI_To_Int (Esize (From)), Float_Rep (From),

                        UI_To_Int (Digits_Value (From)));

   end Copy_Float_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. Special

   --  entities maybe created here as well or may be created from the semantics

   --  module. By not adding them to the Decls list of Standard they will not

   --  be visible to Ada programs.

   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

      procedure Create_Back_End_Float_Types;

      --  Initialize the Back_End_Float_Types list by having the back end

      --  enumerate all available types and building type entities for them.

      procedure Create_Float_Types;

      --  Creates entities for all predefined floating point types, and

      --  adds these to the Predefined_Float_Types list in package Standard.

      procedure Pack_String_Type (String_Type : Entity_Id);

      --  Generate proper tree for pragma Pack that applies to given type, and

      --  mark type as having the pragma.

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

      -- 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;

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

      -- Create_Back_End_Float_Types --

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

      procedure Create_Back_End_Float_Types is

      begin

         Back_End_Float_Types := No_Elist;

         Register_Back_End_Types (Register_Float_Type'Access);

      end Create_Back_End_Float_Types;

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

      -- Create_Float_Types --

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

      procedure Create_Float_Types is

      begin

         --  Create type definition nodes for predefined float types

         Copy_Float_Type

           (Standard_Short_Float,

            Find_Back_End_Float_Type ("float"));

         Set_Is_Implementation_Defined (Standard_Short_Float);

         Copy_Float_Type (Standard_Float, Standard_Short_Float);

         Copy_Float_Type (Standard_Long_Float,

           Find_Back_End_Float_Type ("double"));

         Predefined_Float_Types := New_Elmt_List;

         Append_Elmt (Standard_Short_Float, Predefined_Float_Types);

         Append_Elmt (Standard_Float, Predefined_Float_Types);

         Append_Elmt (Standard_Long_Float, Predefined_Float_Types);

         --  ??? For now, we don't have a good way to tell the widest float

         --  type with hardware support. Basically, GCC knows the size of that

         --  type, but on x86-64 there often are two or three 128-bit types,

         --  one double extended that has 18 decimal digits, a 128-bit quad

         --  precision type with 33 digits and possibly a 128-bit decimal float

         --  type with 34 digits. As a workaround, we define Long_Long_Float as

         --  C's "long double" if that type exists and has at most 18 digits,

         --  or otherwise the same as Long_Float.

         declare

            Max_HW_Digs : constant := 18;

            --  Maximum hardware digits supported

            LLF : Entity_Id := Find_Back_End_Float_Type ("long double");

            --  Entity for long double type

         begin

            if No (LLF) or else Digits_Value (LLF) > Max_HW_Digs then

               LLF := Standard_Long_Float;

            end if;

            Set_Is_Implementation_Defined (Standard_Long_Long_Float);

            Copy_Float_Type (Standard_Long_Long_Float, LLF);

            Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);

         end;

         --  Any other back end types are appended at the end of the list of

         --  predefined float types, and will only be selected if the none of

         --  the types in Standard is suitable, or if a specific named type is

         --  requested through a pragma Import.

         while not Is_Empty_Elmt_List (Back_End_Float_Types) loop

            declare

               E : constant Elmt_Id := First_Elmt (Back_End_Float_Types);

            begin

               Append_Elmt (Node (E), To => Predefined_Float_Types);

               Remove_Elmt (Back_End_Float_Types, E);

            end;

         end loop;

      end Create_Float_Types;

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

      -- Pack_String_Type --

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

      procedure Pack_String_Type (String_Type : Entity_Id) is

         Prag : constant Node_Id :=

                  Make_Pragma (Stloc,

                    Chars                        => Name_Pack,

                    Pragma_Argument_Associations =>

                      New_List (

                        Make_Pragma_Argument_Association (Stloc,

                          Expression =>

                            New_Occurrence_Of (String_Type, Stloc))));

      begin

         Append (Prag, Decl_S);

         Record_Rep_Item (String_Type, Prag);

         Set_Has_Pragma_Pack (String_Type, True);

      end Pack_String_Type;

   --  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_Back_End_Float_Types;

      --  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_Has_Pragma_Ordered         (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);

      Set_Is_Implementation_Defined (Standard_Long_Long_Integer);

      Create_Unconstrained_Base_Type

        (Standard_Short_Short_Integer, E_Signed_Integer_Subtype);

      Set_Is_Implementation_Defined (Standard_Short_Short_Integer);

      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);

      Set_Is_Implementation_Defined (Standard_Short_Short_Integer);

      Create_Float_Types;

      --  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_Has_Pragma_Ordered         (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_Has_Pragma_Ordered         (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.