home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / cstand.adb < prev    next >
Text File  |  1996-09-28  |  47KB  |  1,221 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                               C S T A N D                                --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.153 $                            --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with Atree;    use Atree;
  26. with Csets;    use Csets;
  27. with Einfo;    use Einfo;
  28. with Gnatvsn;  use Gnatvsn;
  29. with Namet;    use Namet;
  30. with Nlists;   use Nlists;
  31. with Nmake;    use Nmake;
  32. with Opt;      use Opt;
  33. with Output;   use Output;
  34. with Tbuild;   use Tbuild;
  35. with Ttypes;   use Ttypes;
  36. with Ttypef;   use Ttypef;
  37. with Sem_Util; use Sem_Util;
  38. with Sinfo;    use Sinfo;
  39. with Snames;   use Snames;
  40. with Stand;    use Stand;
  41. with Types;    use Types;
  42. with Uintp;    use Uintp;
  43. with Urealp;   use Urealp;
  44.  
  45. package body CStand is
  46.  
  47.    Stloc  : constant Source_Ptr := Standard_Location;
  48.    Staloc : constant Source_Ptr := Standard_Ascii_Location;
  49.    --  Standard abbreviations used throughout this package
  50.  
  51.    ---------------------------------------
  52.    -- Format of Standard_Version String --
  53.    ---------------------------------------
  54.  
  55.    --  The purpose of the 16-character string Gnatvsn.Standard_Version is to
  56.    --  make sure that an attempt to bind a program containing units compiled
  57.    --  with incompatible versions of standard does not succeed. In some GCC
  58.    --  ports, the target dependent values in Ttypes may depend on the setting
  59.    --  of command line switches, and we have to be sure that these switches
  60.    --  are set in a compatible manner for all units in a program.
  61.  
  62.    --  At the moment, we record the sizes of the predefined integer and float
  63.    --  types, and also type Address using the following encoding scheme:
  64.  
  65.    --     '1'   8 bits
  66.    --     '2'   16 bits
  67.    --     '3'   32 bits
  68.    --     '4'   64 bits
  69.    --     '5'   128 bits
  70.    --     '6'   other
  71.  
  72.    --  The following declare character positions in the Standard_Version
  73.    --  string used for the predefined types:
  74.  
  75.    SV_Short_Short_Integer : constant := 1;
  76.    SV_Short_Integer       : constant := 2;
  77.    SV_Integer             : constant := 3;
  78.    SV_Long_Integer        : constant := 4;
  79.    SV_Long_Long_Integer   : constant := 5;
  80.    SV_Short_Float         : constant := 6;
  81.    SV_Float               : constant := 7;
  82.    SV_Long_Float          : constant := 8;
  83.    SV_Long_Long_Float     : constant := 9;
  84.    SV_Address             : constant := 10;
  85.  
  86.    -----------------------
  87.    -- Local Subprograms --
  88.    -----------------------
  89.  
  90.    procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int);
  91.    --  Procedure to build standard predefined float base type. The first
  92.    --  parameter is the entity for the type, and the second parameter
  93.    --  is the size in bits. The third parameter is the digits value.
  94.  
  95.    procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int);
  96.    --  Procedure to build standard predefined signed integer base type. The
  97.    --  first parameter is the entity for the type, and the second parameter
  98.    --  is the size in bits.
  99.  
  100.    procedure Create_Operators;
  101.    --  Make entries for each of the predefined operators in Standard
  102.  
  103.    function Encode_Size (Size : Pos) return Character;
  104.    --  Encodes a Size value, using the encoding described in the previous
  105.    --  section on the format of the Standard_Version string.
  106.  
  107.    function Identifier_For (S : Standard_Entity_Type) return Node_Id;
  108.    --  Returns an identifier node with the same name as the defining
  109.    --  identifier corresponding to the given Standard_Entity_Type value
  110.  
  111.    function Make_Formal
  112.      (Typ         : Entity_Id;
  113.       Formal_Name : String)
  114.       return        Entity_Id;
  115.    --  Construct entity for subprogram formal with given name and type
  116.  
  117.    function Make_Integer (V : Uint) return Node_Id;
  118.    --  Builds integer literal with given value
  119.  
  120.    procedure Make_Name (Id : Entity_Id; Nam : String);
  121.    --  Make an entry in the names table for Nam, and set as Chars field of Id
  122.  
  123.    function New_Operator (Op : Name_Id) return Entity_Id;
  124.    --  Build entity for standard operator with given name
  125.  
  126.    function New_Standard_Entity
  127.      (New_Node_Kind : Node_Kind := N_Defining_Identifier)
  128.       return          Entity_Id;
  129.    --  Builds a new entity for Standard, with the Is_Pure flag set and
  130.    --  a source location of Standard_Location
  131.  
  132.    procedure Set_Integer_Bounds
  133.      (Id  : Entity_Id;
  134.       Typ : Entity_Id;
  135.       Lb  : Uint;
  136.       Hb  : Uint);
  137.    --  Procedure to set bounds for integer type or subtype. Id is the entity
  138.    --  whose bounds and type are to be set. The Typ parameter is the Etype
  139.    --  value for the entity (which will be the same as Id for all predefined
  140.    --  integer base types. The third and fourth parameters are the bounds.
  141.  
  142.    procedure Set_Float_Bounds
  143.      (Id  : Entity_Id;
  144.       Typ : Entity_Id);
  145.    --  Procedure to set bounds for float type or subtype. Id is the entity
  146.    --  whose bounds and type are to be set. The Typ parameter is the Etype
  147.    --  value for the entity (which will be the same as Id for all predefined
  148.    --  float base types).
  149.  
  150.    ----------------------
  151.    -- Build_Float_Type --
  152.    ----------------------
  153.  
  154.    procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int) is
  155.    begin
  156.       Set_Type_Definition (Parent (E),
  157.         Make_Floating_Point_Definition (Stloc,
  158.           Digits_Expression => Make_Integer (UI_From_Int (Digs))));
  159.       Set_Ekind                      (E, E_Floating_Point_Type);
  160.       Set_Etype                      (E, E);
  161.       Set_Esize                      (E, UI_From_Int (Siz));
  162.       Set_Digits_Value               (E, UI_From_Int (Digs));
  163.       Set_Float_Bounds               (E, E);
  164.       Set_Is_Frozen                  (E);
  165.       Set_Is_Public                  (E);
  166.       Set_Size_Known_At_Compile_Time (E);
  167.    end Build_Float_Type;
  168.  
  169.    -------------------------------
  170.    -- Build_Signed_Integer_Type --
  171.    -------------------------------
  172.  
  173.    procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int) is
  174.       U2Siz1 : constant Uint := 2 ** (Siz - 1);
  175.       Lbound : constant Uint := -U2Siz1;
  176.       Ubound : constant Uint := U2Siz1 - 1;
  177.  
  178.    begin
  179.       Set_Type_Definition (Parent (E),
  180.         Make_Signed_Integer_Type_Definition (Stloc,
  181.           Low_Bound  => Make_Integer (Lbound),
  182.           High_Bound => Make_Integer (Ubound)));
  183.  
  184.       Set_Ekind                      (E, E_Signed_Integer_Type);
  185.       Set_Etype                      (E, E);
  186.       Set_Esize                      (E, UI_From_Int (Siz));
  187.       Set_Integer_Bounds             (E, E, Lbound, Ubound);
  188.       Set_Is_Frozen                  (E);
  189.       Set_Is_Public                  (E);
  190.       Set_Size_Known_At_Compile_Time (E);
  191.    end Build_Signed_Integer_Type;
  192.  
  193.    ----------------------
  194.    --  Create_Standard --
  195.    ----------------------
  196.  
  197.    --  The tree for the package Standard is prefixed to all compilations.
  198.    --  Several entities required by semantic analysis are denoted by global
  199.    --  variables that are initialized to point to the corresponding
  200.    --  occurences in STANDARD. The visible entities of STANDARD are
  201.    --  created here. The private entities defined in STANDARD are created
  202.    --  by Initialize_Standard in the semantics module.
  203.  
  204.    procedure Create_Standard is
  205.       Decl_S : List_Id;
  206.       --  List of declarations in Standard
  207.  
  208.       Decl_A : List_Id;
  209.       --  List of declarations in Ascii
  210.  
  211.       Decl       : Node_Id;
  212.       Pspec      : Node_Id;
  213.       Tdef_Node  : Node_Id;
  214.       Ident_Node : Node_Id;
  215.       Ccode      : Char_Code;
  216.       E_Id       : Entity_Id;
  217.       R_Node     : Node_Id;
  218.       B_Node     : Node_Id;
  219.  
  220.       procedure Build_Exception (S : Standard_Entity_Type);
  221.       --  Procedure to declare given entity as an exception
  222.  
  223.       procedure Build_Exception (S : Standard_Entity_Type) is
  224.       begin
  225.          Set_Ekind (Standard_Entity (S), E_Exception);
  226.          Set_Etype (Standard_Entity (S), Standard_Exception_Type);
  227.          Set_Is_Public (Standard_Entity (S));
  228.          Decl :=
  229.            Make_Exception_Declaration (Stloc,
  230.              Defining_Identifier => Standard_Entity (S));
  231.          Append (Decl, Decl_S);
  232.       end Build_Exception;
  233.  
  234.    --  Start of processing for Create_Standard
  235.  
  236.    begin
  237.       Decl_S := New_List;
  238.  
  239.       --  First step is to create defining identifiers for each entity
  240.  
  241.       for S in Standard_Entity_Type loop
  242.          declare
  243.             S_Name : constant String := Standard_Entity_Type'Image (S);
  244.             --  Name of entity (note we skip S_ at the start)
  245.  
  246.             Ident_Node : Node_Id;
  247.             --  Defining identifier node
  248.  
  249.          begin
  250.             Ident_Node := New_Standard_Entity;
  251.             Make_Name (Ident_Node, S_Name (3 .. S_Name'Length));
  252.             Standard_Entity (S) := Ident_Node;
  253.          end;
  254.       end loop;
  255.  
  256.       --  Create package declaration node for package Standard
  257.  
  258.       Standard_Package_Node := New_Node (N_Package_Declaration, Stloc);
  259.  
  260.       Pspec := New_Node (N_Package_Specification, Stloc);
  261.       Set_Specification (Standard_Package_Node, Pspec);
  262.  
  263.       Set_Defining_Unit_Name (Pspec, Standard_Standard);
  264.       Set_Visible_Declarations (Pspec, Decl_S);
  265.  
  266.       Set_Ekind (Standard_Standard, E_Package);
  267.       Set_Is_Pure (Standard_Standard);
  268.  
  269.       --  Create type declaration nodes for standard types
  270.  
  271.       for S in S_Types loop
  272.          Decl := New_Node (N_Full_Type_Declaration, Stloc);
  273.          Set_Defining_Identifier (Decl, Standard_Entity (S));
  274.          Set_Is_Frozen (Standard_Entity (S));
  275.          Set_Is_Public (Standard_Entity (S));
  276.          Append (Decl, Decl_S);
  277.       end loop;
  278.  
  279.       --  Create type definition node for type Boolean. The Size is set to
  280.       --  1 as required by Ada 95 and current ARG interpretations for Ada/83.
  281.  
  282.       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
  283.       Set_Literals (Tdef_Node, New_List);
  284.       Append (Standard_False, Literals (Tdef_Node));
  285.       Append (Standard_True, Literals (Tdef_Node));
  286.       Set_Type_Definition (Parent (Standard_Boolean), Tdef_Node);
  287.  
  288.       Set_Ekind         (Standard_Boolean, E_Enumeration_Type);
  289.       Set_First_Literal (Standard_Boolean, Standard_False);
  290.       Set_Etype         (Standard_Boolean, Standard_Boolean);
  291.       Set_Esize         (Standard_Boolean, Uint_1);
  292.       Set_Size_Known_At_Compile_Time
  293.                         (Standard_Boolean);
  294.  
  295.       Set_Ekind           (Standard_True, E_Enumeration_Literal);
  296.       Set_Etype           (Standard_True, Standard_Boolean);
  297.       Set_Enumeration_Pos (Standard_True, Uint_1);
  298.       Set_Enumeration_Rep (Standard_True, Uint_1);
  299.  
  300.       Set_Ekind           (Standard_False, E_Enumeration_Literal);
  301.       Set_Etype           (Standard_False, Standard_Boolean);
  302.       Set_Enumeration_Pos (Standard_False, Uint_0);
  303.       Set_Enumeration_Rep (Standard_False, Uint_0);
  304.  
  305.       --  For the bounds of Boolean, we create a range node corresponding to
  306.  
  307.       --    range False .. True
  308.  
  309.       --  where the occurrences of the literals must point to the
  310.       --  corresponding  definition.
  311.  
  312.       R_Node := New_Node (N_Range, Stloc);
  313.       B_Node := New_Node (N_Identifier, Stloc);
  314.       Set_Chars  (B_Node, Chars (Standard_False));
  315.       Set_Entity (B_Node,  Standard_False);
  316.       Set_Etype  (B_Node, Standard_Boolean);
  317.       Set_Is_Static_Expression (B_Node);
  318.       Set_Low_Bound  (R_Node, B_Node);
  319.  
  320.       B_Node := New_Node (N_Identifier, Stloc);
  321.       Set_Chars  (B_Node, Chars (Standard_True));
  322.       Set_Entity (B_Node,  Standard_True);
  323.       Set_Etype  (B_Node, Standard_Boolean);
  324.       Set_Is_Static_Expression (B_Node);
  325.       Set_High_Bound (R_Node, B_Node);
  326.  
  327.       Set_Scalar_Range (Standard_Boolean, R_Node);
  328.  
  329.       --  Create type definition nodes for predefined integer types
  330.  
  331.       Build_Signed_Integer_Type
  332.         (Standard_Short_Short_Integer, Standard_Short_Short_Integer_Size);
  333.  
  334.       Build_Signed_Integer_Type
  335.         (Standard_Short_Integer, Standard_Short_Integer_Size);
  336.  
  337.       Build_Signed_Integer_Type
  338.         (Standard_Integer, Standard_Integer_Size);
  339.  
  340.       Build_Signed_Integer_Type
  341.         (Standard_Long_Integer, Standard_Long_Integer_Size);
  342.  
  343.       Build_Signed_Integer_Type
  344.         (Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size);
  345.  
  346.       --  Create type definition nodes for predefined float types
  347.  
  348.       Build_Float_Type
  349.         (Standard_Short_Float,
  350.          Standard_Short_Float_Size,
  351.          Standard_Short_Float_Digits);
  352.  
  353.       Build_Float_Type
  354.         (Standard_Float,
  355.          Standard_Float_Size,
  356.          Standard_Float_Digits);
  357.  
  358.       Build_Float_Type
  359.         (Standard_Long_Float,
  360.          Standard_Long_Float_Size,
  361.          Standard_Long_Float_Digits);
  362.  
  363.       Build_Float_Type
  364.         (Standard_Long_Long_Float,
  365.          Standard_Long_Long_Float_Size,
  366.          Standard_Long_Long_Float_Digits);
  367.  
  368.       --  Create type definition node for type Character. Note that we do not
  369.       --  set the Literals field, since type Character is handled with special
  370.       --  routine that do not need a literal list.
  371.  
  372.       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
  373.       Set_Type_Definition (Parent (Standard_Character), Tdef_Node);
  374.  
  375.       Set_Ekind (Standard_Character, E_Enumeration_Type);
  376.       Set_Etype (Standard_Character, Standard_Character);
  377.       Set_Esize (Standard_Character, UI_From_Int (Standard_Character_Size));
  378.  
  379.       Set_Is_Character_Type (Standard_Character, True);
  380.       Set_Size_Known_At_Compile_Time (Standard_Character);
  381.  
  382.       --  Create the bounds for type Character.
  383.  
  384.       R_Node := New_Node (N_Range, Stloc);
  385.  
  386.       --  Low bound for type Character (Standard.Nul)
  387.  
  388.       B_Node := New_Node (N_Character_Literal, Stloc);
  389.       Set_Is_Static_Expression (B_Node);
  390.       Set_Chars                (B_Node, No_Name);
  391.       Set_Char_Literal_Value   (B_Node, 16#00#);
  392.       Set_Entity               (B_Node,  Empty);
  393.       Set_Etype                (B_Node, Standard_Character);
  394.       Set_Low_Bound (R_Node, B_Node);
  395.  
  396.       --  High bound for type Character
  397.  
  398.       B_Node := New_Node (N_Character_Literal, Stloc);
  399.       Set_Is_Static_Expression (B_Node);
  400.       Set_Chars                (B_Node, No_Name);
  401.       Set_Char_Literal_Value   (B_Node, 16#FF#);
  402.       Set_Entity               (B_Node,  Empty);
  403.       Set_Etype                (B_Node, Standard_Character);
  404.       Set_High_Bound (R_Node, B_Node);
  405.  
  406.       Set_Scalar_Range (Standard_Character, R_Node);
  407.  
  408.       --  Create type definition for type Wide_Character. Note that we do not
  409.       --  set the Literals field, since type Wide_Character is handled with
  410.       --  special routines that do not need a literal list.
  411.  
  412.       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
  413.       Set_Type_Definition (Parent (Standard_Wide_Character), Tdef_Node);
  414.  
  415.       Set_Ekind             (Standard_Wide_Character, E_Enumeration_Type);
  416.       Set_Etype             (Standard_Wide_Character, Standard_Wide_Character);
  417.       Set_Esize             (Standard_Wide_Character, Uint_16);
  418.       Set_Is_Character_Type (Standard_Wide_Character, True);
  419.       Set_Size_Known_At_Compile_Time
  420.                             (Standard_Wide_Character);
  421.  
  422.       --  Create the bounds for type Wide_Character.
  423.  
  424.       R_Node := New_Node (N_Range, Stloc);
  425.  
  426.       --  Low bound for type Wide_Character
  427.  
  428.       B_Node := New_Node (N_Character_Literal, Stloc);
  429.       Set_Is_Static_Expression (B_Node);
  430.       Set_Chars                (B_Node, No_Name);    --  ???
  431.       Set_Char_Literal_Value   (B_Node, 16#0000#);
  432.       Set_Entity               (B_Node,  Empty);
  433.       Set_Etype                (B_Node, Standard_Wide_Character);
  434.       Set_Low_Bound (R_Node, B_Node);
  435.  
  436.       --  High bound for type Wide_Character
  437.  
  438.       B_Node := New_Node (N_Character_Literal, Stloc);
  439.       Set_Is_Static_Expression (B_Node);
  440.       Set_Chars                (B_Node, No_Name);    --  ???
  441.       Set_Char_Literal_Value   (B_Node, 16#FFFF#);
  442.       Set_Entity               (B_Node,  Empty);
  443.       Set_Etype                (B_Node, Standard_Wide_Character);
  444.       Set_High_Bound           (R_Node, B_Node);
  445.  
  446.       Set_Scalar_Range (Standard_Wide_Character, R_Node);
  447.  
  448.       --  Create type definition node for type String
  449.  
  450.       Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
  451.       Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Character));
  452.       Set_Subtype_Marks      (Tdef_Node, New_List);
  453.       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
  454.       Set_Type_Definition (Parent (Standard_String), Tdef_Node);
  455.  
  456.       Set_Ekind          (Standard_String, E_String_Type);
  457.       Set_Etype          (Standard_String, Standard_String);
  458.       Set_Component_Type (Standard_String, Standard_Character);
  459.       Set_Esize          (Standard_String, Uint_0);
  460.  
  461.       --  Set index type of String
  462.  
  463.       E_Id := First
  464.         (Subtype_Marks (Type_Definition (Parent (Standard_String))));
  465.       Set_First_Index (Standard_String, E_Id);
  466.       Set_Entity (E_Id, Standard_Positive);
  467.       Set_Etype (E_Id, Standard_Positive);
  468.  
  469.       --  Create type definition node for type Wide_String
  470.  
  471.       Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
  472.       Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Wide_Character));
  473.       Set_Subtype_Marks (Tdef_Node, New_List);
  474.       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
  475.       Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
  476.  
  477.       Set_Ekind          (Standard_Wide_String, E_String_Type);
  478.       Set_Etype          (Standard_Wide_String, Standard_Wide_String);
  479.       Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
  480.       Set_Esize          (Standard_Wide_String, Uint_0);
  481.  
  482.       --  Set index type of Wide_String
  483.  
  484.       E_Id := First
  485.         (Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
  486.       Set_First_Index (Standard_Wide_String, E_Id);
  487.       Set_Entity (E_Id, Standard_Positive);
  488.       Set_Etype (E_Id, Standard_Positive);
  489.  
  490.       --  Create subtype declaration for Natural
  491.  
  492.       Decl := New_Node (N_Subtype_Declaration, Stloc);
  493.       Set_Defining_Identifier (Decl, Standard_Natural);
  494.       Set_Subtype_Indication (Decl,
  495.         New_Occurrence_Of (Standard_Integer, Stloc));
  496.       Append (Decl, Decl_S);
  497.  
  498.       Set_Ekind     (Standard_Natural, E_Signed_Integer_Subtype);
  499.       Set_Etype     (Standard_Natural, Standard_Integer);
  500.       Set_Esize     (Standard_Natural, Esize (Standard_Integer));
  501.       Set_Size_Known_At_Compile_Time
  502.                     (Standard_Natural);
  503.       Set_Integer_Bounds
  504.         (Id  => Standard_Natural,
  505.          Typ => Standard_Integer,
  506.          Lb  => Uint_0,
  507.          Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
  508.       Set_Is_Frozen (Standard_Natural);
  509.       Set_Is_Public (Standard_Natural);
  510.  
  511.       --  Create subtype declaration for Positive
  512.  
  513.       Decl := New_Node (N_Subtype_Declaration, Stloc);
  514.       Set_Defining_Identifier (Decl, Standard_Positive);
  515.       Set_Subtype_Indication (Decl,
  516.         New_Occurrence_Of (Standard_Integer, Stloc));
  517.       Append (Decl, Decl_S);
  518.  
  519.       Set_Ekind     (Standard_Positive, E_Signed_Integer_Subtype);
  520.       Set_Etype     (Standard_Positive, Standard_Integer);
  521.       Set_Esize     (Standard_Positive, Esize (Standard_Integer));
  522.       Set_Size_Known_At_Compile_Time
  523.                     (Standard_Positive);
  524.  
  525.       Set_Integer_Bounds
  526.         (Id  => Standard_Positive,
  527.          Typ => Standard_Integer,
  528.          Lb  => Uint_1,
  529.          Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
  530.       Set_Is_Frozen (Standard_Positive);
  531.       Set_Is_Public (Standard_Positive);
  532.  
  533.       --  Create subtype declaration for Duration. For the moment, this is
  534.       --  represented as a Long_Float value, eventually it should be a 64-bit
  535.       --  fixed-point type.
  536.  
  537.       Decl := New_Node (N_Subtype_Declaration, Stloc);
  538.       Set_Defining_Identifier (Decl, Standard_Duration);
  539.       Set_Subtype_Indication (Decl,
  540.         New_Occurrence_Of (Standard_Long_Float, Stloc));
  541.       Append (Decl, Decl_S);
  542.  
  543.       Set_Ekind        (Standard_Duration, E_Floating_Point_Subtype);
  544.       Set_Etype        (Standard_Duration, Standard_Long_Float);
  545.       Set_Esize        (Standard_Duration, Esize (Standard_Long_Float));
  546.       Set_Scalar_Range (Standard_Duration,
  547.                          Scalar_Range (Standard_Long_Float));
  548.       Set_Digits_Value (Standard_Duration,
  549.                          UI_From_Int (Standard_Long_Float_Digits));
  550.  
  551.       Set_Size_Known_At_Compile_Time (Standard_Duration);
  552.  
  553.       --  Create declaration for package Ascii
  554.  
  555.       Decl := New_Node (N_Package_Declaration, Stloc);
  556.       Append (Decl, Decl_S);
  557.  
  558.       Pspec := New_Node (N_Package_Specification, Stloc);
  559.       Set_Specification (Decl, Pspec);
  560.  
  561.       Set_Defining_Unit_Name (Pspec, Standard_Entity (S_Ascii));
  562.       Set_Ekind (Standard_Entity (S_Ascii), E_Package);
  563.       Decl_A := New_List; -- for ASCII declarations
  564.       Set_Visible_Declarations (Pspec, Decl_A);
  565.  
  566.       --  Create control character definitions in package ASCII. Note that
  567.       --  the character literal entries created here correspond to literal
  568.       --  values that are impossible in the source, but can be represented
  569.       --  internally with no difficulties.
  570.  
  571.       Ccode := 16#00#;
  572.  
  573.       for S in S_Ascii_Names loop
  574.          Decl := New_Node (N_Object_Declaration, Staloc);
  575.          Set_Constant_Present (Decl, True);
  576.  
  577.          declare
  578.             A_Char    : Entity_Id := Standard_Entity (S);
  579.             Expr_Decl : Node_Id;
  580.  
  581.          begin
  582.             Set_Sloc  (A_Char, Staloc);
  583.             Set_Ekind (A_Char, E_Constant);
  584.             Set_Etype (A_Char, Standard_Character);
  585.             Set_Scope (A_Char, Standard_Entity (S_Ascii));
  586.             Set_Is_Immediately_Visible (A_Char, False);
  587.             Set_Is_Public (A_Char);
  588.             Append_Entity (A_Char, Standard_Entity (S_Ascii));
  589.             Set_Defining_Identifier (Decl, A_Char);
  590.  
  591.             Set_Object_Definition (Decl, Identifier_For (S_Character));
  592.             Expr_Decl := New_Node (N_Character_Literal, Staloc);
  593.             Set_Expression (Decl, Expr_Decl);
  594.  
  595.             Set_Is_Static_Expression (Expr_Decl);
  596.             Set_Chars                (Expr_Decl, No_Name);
  597.             Set_Etype                (Expr_Decl, Standard_Character);
  598.             Set_Char_Literal_Value   (Expr_Decl, Ccode);
  599.          end;
  600.  
  601.          Append (Decl, Decl_A);
  602.  
  603.          --  Increment character code, dealing with non-contiguities
  604.  
  605.          Ccode := Ccode + 1;
  606.  
  607.          if Ccode = 16#20# then
  608.             Ccode := 16#21#;
  609.          elsif Ccode = 16#27# then
  610.             Ccode := 16#3A#;
  611.          elsif Ccode = 16#3C# then
  612.             Ccode := 16#3F#;
  613.          elsif Ccode = 16#41# then
  614.             Ccode := 16#5B#;
  615.          end if;
  616.       end loop;
  617.  
  618.       --  Create semantic phase entities
  619.  
  620.       Standard_Void_Type := New_Standard_Entity;
  621.       Set_Ekind (Standard_Void_Type, E_Void);
  622.       Set_Etype (Standard_Void_Type, Standard_Void_Type);
  623.       Set_Esize (Standard_Void_Type, Uint_0);
  624.       Set_Scope (Standard_Void_Type, Standard_Standard);
  625.       Make_Name (Standard_Void_Type, "_void_type");
  626.  
  627.       --  The type field of packages is set to void
  628.  
  629.       Set_Etype (Standard_Standard, Standard_Void_Type);
  630.       Set_Etype (Standard_Ascii, Standard_Void_Type);
  631.  
  632.       --  Standard_A_String is actually used in generated code, so it has a
  633.       --  type name that is reasonable, but does not overlap any Ada name.
  634.  
  635.       Standard_A_String := New_Standard_Entity;
  636.       Set_Ekind     (Standard_A_String, E_Access_Type);
  637.       Set_Scope     (Standard_A_String, Standard_Standard);
  638.       Set_Etype     (Standard_A_String, Standard_A_String);
  639.       Set_Esize     (Standard_A_String, UI_From_Int (System_Address_Size));
  640.  
  641.       Set_Directly_Designated_Type (Standard_A_String, Standard_String);
  642.       Make_Name     (Standard_A_String, "access_string");
  643.  
  644.       --  Note on type names. The type names for the following special types
  645.       --  are constructed so that they will look reasonable should they ever
  646.       --  appear in error messages etc, although in practice the use of the
  647.       --  special insertion character } for types results in special handling
  648.       --  of these type names in any case. The blanks in these names would
  649.       --  trouble in Gigi, but that's OK here, since none of these types
  650.       --  should ever get through to Gigi! Attributes of these types are
  651.       --  filled out to minimize problems with cascaded errors (for example,
  652.       --  Any_Integer is given reasonable and consistent type and size values)
  653.  
  654.       Any_Type := New_Standard_Entity;
  655.       Set_Ekind (Any_Type, E_Signed_Integer_Type);
  656.       Set_Scope (Any_Type, Standard_Standard);
  657.       Set_Etype (Any_Type, Any_Type);
  658.       Set_Esize (Any_Type, Uint_0);
  659.       Make_Name (Any_Type, "any type");
  660.  
  661.       Any_Id := New_Standard_Entity;
  662.       Set_Ekind (Any_Id, E_Variable);
  663.       Set_Scope (Any_Id, Standard_Standard);
  664.       Set_Etype (Any_Id, Any_Type);
  665.       Set_Esize (Any_Id, Uint_0);
  666.       Make_Name (Any_Id, "any id");
  667.  
  668.       Any_Access := New_Standard_Entity;
  669.       Set_Ekind (Any_Access, E_Access_Type);
  670.       Set_Scope (Any_Access, Standard_Standard);
  671.       Set_Etype (Any_Access, Any_Access);
  672.       Set_Esize (Any_Access, UI_From_Int (System_Address_Size));
  673.       Make_Name (Any_Access, "an access type");
  674.  
  675.       Any_Array := New_Standard_Entity;
  676.       Set_Ekind (Any_Array, E_String_Type);
  677.       Set_Scope (Any_Array, Standard_Standard);
  678.       Set_Etype (Any_Array, Any_Array);
  679.       Set_Component_Type (Any_Array, Any_Character);
  680.       Set_Esize (Any_Array, Uint_0);
  681.       Make_Name (Any_Array, "an array type");
  682.  
  683.       Any_Boolean := New_Standard_Entity;
  684.       Set_Ekind (Any_Boolean, E_Enumeration_Type);
  685.       Set_Scope (Any_Boolean, Standard_Standard);
  686.       Set_Etype (Any_Boolean, Standard_Boolean);
  687.       Set_Esize (Any_Boolean, UI_From_Int (1));
  688.       Set_Scalar_Range (Any_Boolean, Scalar_Range (Standard_Boolean));
  689.       Make_Name (Any_Boolean, "a boolean type");
  690.  
  691.       Any_Character := New_Standard_Entity;
  692.       Set_Ekind (Any_Character, E_Enumeration_Type);
  693.       Set_Scope (Any_Character, Standard_Standard);
  694.       Set_Etype (Any_Character, Any_Character);
  695.       Set_Is_Character_Type (Any_Character);
  696.       Set_Esize (Any_Character, UI_From_Int (Standard_Character_Size));
  697.       Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
  698.       Make_Name (Any_Character, "a character type");
  699.  
  700.       Any_Composite := New_Standard_Entity;
  701.       Set_Ekind (Any_Composite, E_Array_Type);
  702.       Set_Scope (Any_Composite, Standard_Standard);
  703.       Set_Etype (Any_Composite, Any_Composite);
  704.       Set_Component_Type (Any_Composite, Standard_Integer);
  705.       Set_Esize (Any_Composite, Uint_0);
  706.       Make_Name (Any_Composite, "a composite type");
  707.  
  708.       Any_Discrete := New_Standard_Entity;
  709.       Set_Ekind (Any_Discrete, E_Signed_Integer_Type);
  710.       Set_Scope (Any_Discrete, Standard_Standard);
  711.       Set_Etype (Any_Discrete, Any_Discrete);
  712.       Set_Esize (Any_Discrete, UI_From_Int (Standard_Integer_Size));
  713.       Make_Name (Any_Discrete, "a discrete type");
  714.  
  715.       Any_Fixed := New_Standard_Entity;
  716.       Set_Ekind (Any_Fixed, E_Ordinary_Fixed_Point_Type);
  717.       Set_Scope (Any_Fixed, Standard_Standard);
  718.       Set_Etype (Any_Fixed, Any_Fixed);
  719.       Make_Name (Any_Fixed, "a fixed-point type");
  720.  
  721.       Any_Integer := New_Standard_Entity;
  722.       Set_Ekind (Any_Integer, E_Signed_Integer_Type);
  723.       Set_Scope (Any_Integer, Standard_Standard);
  724.       Set_Etype (Any_Integer, Standard_Long_Long_Integer);
  725.       Make_Name (Any_Integer, "an integer type");
  726.       Set_Esize (Any_Integer, Esize (Standard_Long_Long_Integer));
  727.  
  728.       Any_Numeric := New_Standard_Entity;
  729.       Set_Ekind (Any_Numeric, E_Signed_Integer_Type);
  730.       Set_Scope (Any_Numeric, Standard_Standard);
  731.       Set_Etype (Any_Numeric, Standard_Long_Long_Integer);
  732.       Make_Name (Any_Numeric, "a numeric type");
  733.       Set_Esize (Any_Numeric, Esize (Standard_Long_Long_Integer));
  734.  
  735.       Any_Real := New_Standard_Entity;
  736.       Set_Ekind (Any_Real, E_Floating_Point_Type);
  737.       Set_Scope (Any_Real, Standard_Standard);
  738.       Set_Etype (Any_Real, Standard_Long_Long_Float);
  739.       Make_Name (Any_Real, "a real type");
  740.       Set_Esize (Any_Real, Esize (Standard_Long_Long_Float));
  741.  
  742.       Any_Scalar := New_Standard_Entity;
  743.       Set_Ekind (Any_Scalar, E_Signed_Integer_Type);
  744.       Set_Scope (Any_Scalar, Standard_Standard);
  745.       Set_Etype (Any_Scalar, Any_Scalar);
  746.       Set_Esize (Any_Scalar, UI_From_Int (Standard_Integer_Size));
  747.       Make_Name (Any_Scalar, "a scalar type");
  748.  
  749.       Any_String := New_Standard_Entity;
  750.       Set_Ekind (Any_String, E_String_Type);
  751.       Set_Scope (Any_String, Standard_Standard);
  752.       Set_Etype (Any_String, Any_String);
  753.       Set_Component_Type (Any_String, Any_Character);
  754.       Set_Esize (Any_String, Uint_0);
  755.       Make_Name (Any_String, "a string type");
  756.  
  757.       Standard_Integer_8 := New_Standard_Entity;
  758.       Decl := New_Node (N_Full_Type_Declaration, Stloc);
  759.       Set_Defining_Identifier (Decl, Standard_Integer_8);
  760.       Make_Name (Standard_Integer_8, "integer_8");
  761.       Set_Scope (Standard_Integer_8, Standard_Standard);
  762.       Build_Signed_Integer_Type (Standard_Integer_8, 8);
  763.  
  764.       Standard_Integer_16 := New_Standard_Entity;
  765.       Decl := New_Node (N_Full_Type_Declaration, Stloc);
  766.       Set_Defining_Identifier (Decl, Standard_Integer_16);
  767.       Make_Name (Standard_Integer_16, "integer_16");
  768.       Set_Scope (Standard_Integer_16, Standard_Standard);
  769.       Build_Signed_Integer_Type (Standard_Integer_16, 16);
  770.  
  771.       Standard_Integer_32 := New_Standard_Entity;
  772.       Decl := New_Node (N_Full_Type_Declaration, Stloc);
  773.       Set_Defining_Identifier (Decl, Standard_Integer_32);
  774.       Make_Name (Standard_Integer_32, "integer_32");
  775.       Set_Scope (Standard_Integer_32, Standard_Standard);
  776.       Build_Signed_Integer_Type (Standard_Integer_32, 32);
  777.  
  778.       Standard_Integer_64 := New_Standard_Entity;
  779.       Decl := New_Node (N_Full_Type_Declaration, Stloc);
  780.       Set_Defining_Identifier (Decl, Standard_Integer_64);
  781.       Make_Name (Standard_Integer_64, "integer_64");
  782.       Set_Scope (Standard_Integer_64, Standard_Standard);
  783.       Build_Signed_Integer_Type (Standard_Integer_64, 64);
  784.  
  785.       --  Note: universal integer and universal real are constructed as fully
  786.       --  formed signed numeric types, with parameters corresponding to the
  787.       --  longest runtime types (Long_Long_Integer and Long_Long_Float). This
  788.       --  allows Gigi to properly process references to universal types that
  789.       --  are not folded at compile time.
  790.  
  791.       Universal_Integer := New_Standard_Entity;
  792.       Decl := New_Node (N_Full_Type_Declaration, Stloc);
  793.       Set_Defining_Identifier (Decl, Universal_Integer);
  794.       Make_Name (Universal_Integer, "universal_integer");
  795.       Set_Scope (Universal_Integer, Standard_Standard);
  796.       Build_Signed_Integer_Type
  797.         (Universal_Integer, Standard_Long_Long_Integer_Size);
  798.  
  799.       Universal_Real := New_Standard_Entity;
  800.       Decl := New_Node (N_Full_Type_Declaration, Stloc);
  801.       Set_Defining_Identifier (Decl, Universal_Real);
  802.       Make_Name (Universal_Real, "universal_real");
  803.       Set_Scope (Universal_Real, Standard_Standard);
  804.       Build_Float_Type
  805.         (Universal_Real,
  806.          Standard_Long_Long_Float_Size,
  807.          Standard_Long_Long_Float_Digits);
  808.  
  809.       --  Note: universal fixed, unlike universal integer and universal real,
  810.       --  is never used at runtime, so it does not need to have bounds set.
  811.  
  812.       Universal_Fixed := New_Standard_Entity;
  813.       Decl := New_Node (N_Full_Type_Declaration, Stloc);
  814.       Set_Defining_Identifier (Decl, Universal_Fixed);
  815.       Make_Name (Universal_Fixed, "universal_fixed");
  816.       Set_Ekind (Universal_Fixed, E_Ordinary_Fixed_Point_Type);
  817.       Set_Etype (Universal_Fixed, Universal_Fixed);
  818.       Set_Scope (Universal_Fixed, Standard_Standard);
  819.       Set_Esize
  820.         (Universal_Fixed, UI_From_Int (Standard_Long_Long_Integer_Size));
  821.       Set_Size_Known_At_Compile_Time (Universal_Fixed);
  822.  
  823.       --  Build standard exception type. Note that the type name here is
  824.       --  actually used in the generated code, so it must be set correctly
  825.  
  826.       Standard_Exception_Type := New_Standard_Entity;
  827.       Set_Ekind (Standard_Exception_Type, E_Exception_Type);
  828.       Set_Etype (Standard_Exception_Type, Standard_Exception_Type);
  829.       Set_Scope (Standard_Exception_Type, Standard_Standard);
  830.       Set_Esize (Standard_Exception_Type, Uint_0);
  831.       Set_Size_Known_At_Compile_Time
  832.                 (Standard_Exception_Type);
  833.       Make_Name (Standard_Exception_Type, "exception");
  834.  
  835.       --  Create declarations of standard exceptions
  836.  
  837.       Build_Exception (S_Constraint_Error);
  838.       Build_Exception (S_Program_Error);
  839.       Build_Exception (S_Storage_Error);
  840.       Build_Exception (S_Tasking_Error);
  841.  
  842.       --  Numeric_Error is a normal exception in Ada 83, but in Ada 95
  843.       --  it is a renaming of Constraint_Error
  844.  
  845.       if Ada_83 then
  846.          Build_Exception (S_Numeric_Error);
  847.  
  848.       else
  849.          Decl := New_Node (N_Exception_Renaming_Declaration, Stloc);
  850.          E_Id := Standard_Entity (S_Numeric_Error);
  851.  
  852.          Set_Ekind     (E_Id, E_Exception);
  853.          Set_Etype     (E_Id, Standard_Exception_Type);
  854.          Set_Is_Public (E_Id);
  855.  
  856.          Set_Renamed_Object (E_Id, Standard_Entity (S_Constraint_Error));
  857.  
  858.          Set_Defining_Identifier (Decl, E_Id);
  859.          Append (Decl, Decl_S);
  860.  
  861.          Ident_Node := New_Node (N_Identifier, Stloc);
  862.          Set_Chars  (Ident_Node, Chars (Standard_Entity (S_Constraint_Error)));
  863.          Set_Entity (Ident_Node, Standard_Entity (S_Constraint_Error));
  864.          Set_Name   (Decl, Ident_Node);
  865.       end if;
  866.  
  867.       --  Abort_Signal is an entity that does not get made visible
  868.  
  869.       Abort_Signal := New_Standard_Entity;
  870.       Set_Chars     (Abort_Signal, Name_uAbort_Signal);
  871.       Set_Ekind     (Abort_Signal, E_Exception);
  872.       Set_Etype     (Abort_Signal, Standard_Exception_Type);
  873.       Set_Is_Public (Abort_Signal, True);
  874.       Decl :=
  875.         Make_Exception_Declaration (Stloc,
  876.           Defining_Identifier => Abort_Signal);
  877.  
  878.       --  Create defining identifiers for shift operator entities. Note
  879.       --  that these entities are used only for marking shift operators
  880.       --  generated internally, and hence need no structure, just a name
  881.       --  and a unique identity.
  882.  
  883.       Standard_Op_Rotate_Left := New_Standard_Entity;
  884.       Set_Chars (Standard_Op_Rotate_Left, Name_Rotate_Left);
  885.       Set_Ekind (Standard_Op_Rotate_Left, E_Operator);
  886.  
  887.       Standard_Op_Rotate_Right := New_Standard_Entity;
  888.       Set_Chars (Standard_Op_Rotate_Right, Name_Rotate_Right);
  889.       Set_Ekind (Standard_Op_Rotate_Right, E_Operator);
  890.  
  891.       Standard_Op_Shift_Left := New_Standard_Entity;
  892.       Set_Chars (Standard_Op_Shift_Left, Name_Shift_Left);
  893.       Set_Ekind (Standard_Op_Shift_Left, E_Operator);
  894.  
  895.       Standard_Op_Shift_Right := New_Standard_Entity;
  896.       Set_Chars (Standard_Op_Shift_Right, Name_Shift_Right);
  897.       Set_Ekind (Standard_Op_Shift_Right, E_Operator);
  898.  
  899.       Standard_Op_Shift_Right_Arithmetic := New_Standard_Entity;
  900.       Set_Chars (Standard_Op_Shift_Right_Arithmetic,
  901.                                           Name_Shift_Right_Arithmetic);
  902.       Set_Ekind (Standard_Op_Shift_Right_Arithmetic,
  903.                                           E_Operator);
  904.  
  905.       --  Create standard operator declarations
  906.  
  907.       Create_Operators;
  908.  
  909.       --  Initialize visibility table with entities in Standard
  910.  
  911.       for E in Standard_Entity_Type loop
  912.          if Ekind (Standard_Entity (E)) /= E_Operator then
  913.             Set_Name_Entity_Id
  914.               (Chars (Standard_Entity (E)), Standard_Entity (E));
  915.             Set_Homonym (Standard_Entity (E), Empty);
  916.          end if;
  917.  
  918.          if E not in S_Ascii_Names then
  919.             Set_Scope (Standard_Entity (E), Standard_Standard);
  920.             Set_Is_Immediately_Visible (Standard_Entity (E));
  921.          end if;
  922.       end loop;
  923.  
  924.       --  The predefined package Standard itself does not have a scope;
  925.       --  it is the only entity in the system not to have one, and this
  926.       --  is what identifies the package to Gigi.
  927.  
  928.       Set_Scope (Standard_Standard, Empty);
  929.  
  930.       --  Set global variables indicating last Id values and version
  931.  
  932.       Last_Standard_Node_Id := Last_Node_Id;
  933.       Last_Standard_List_Id := Last_List_Id;
  934.  
  935.       --  Initialize Standard_Version string
  936.  
  937.       Standard_Version (SV_Short_Short_Integer) :=
  938.          Encode_Size (Standard_Short_Short_Integer_Size);
  939.       Standard_Version (SV_Short_Integer)       :=
  940.          Encode_Size (Standard_Short_Integer_Size);
  941.       Standard_Version (SV_Integer)             :=
  942.          Encode_Size (Standard_Integer_Size);
  943.       Standard_Version (SV_Long_Integer)        :=
  944.          Encode_Size (Standard_Long_Integer_Size);
  945.       Standard_Version (SV_Long_Long_Integer)   :=
  946.          Encode_Size (Standard_Long_Long_Integer_Size);
  947.       Standard_Version (SV_Short_Float)         :=
  948.          Encode_Size (Standard_Short_Float_Size);
  949.       Standard_Version (SV_Float)               :=
  950.          Encode_Size (Standard_Float_Size);
  951.       Standard_Version (SV_Long_Float)          :=
  952.          Encode_Size (Standard_Long_Float_Size);
  953.       Standard_Version (SV_Long_Long_Float)     :=
  954.          Encode_Size (Standard_Long_Long_Float_Size);
  955.       Standard_Version (SV_Address)             :=
  956.          Encode_Size (System_Address_Size);
  957.  
  958.    end Create_Standard;
  959.  
  960.    ----------------------
  961.    -- Create_Operators --
  962.    ----------------------
  963.  
  964.    --  Each operator has an abbreviated signature. The formals have the names
  965.    --  LEFT and RIGHT. Their types are not actually used for resolution.
  966.  
  967.    procedure Create_Operators is
  968.       Op_Node : Entity_Id;
  969.  
  970.       type Binary_Names is array (S_Binary_Ops) of Name_Id;
  971.  
  972.       --  Following list has two entries for concatenation, to include
  973.       --  explicitly the operation on wide strings.
  974.  
  975.       Binary_Ops : constant array (S_Binary_Ops) of Name_Id :=
  976.         (Name_Op_Add,      Name_Op_And,   Name_Op_Concat,   Name_Op_Concat,
  977.          Name_Op_Divide,   Name_Op_Eq,    Name_Op_Expon,    Name_Op_Ge,
  978.          Name_Op_Gt,       Name_Op_Le,    Name_Op_Lt,       Name_Op_Mod,
  979.          Name_Op_Multiply, Name_Op_Ne,    Name_Op_Or,       Name_Op_Rem,
  980.          Name_Op_Subtract, Name_Op_Xor);
  981.  
  982.       Unary_Ops : constant array (S_Unary_Ops) of Name_Id :=
  983.         (Name_Op_Abs, Name_Op_Subtract, Name_Op_Not, Name_Op_Add);
  984.  
  985.       --  Corresponding to Abs, Minus, Not, and Plus.
  986.  
  987.    begin
  988.       for J in S_Binary_Ops loop
  989.          Op_Node := New_Operator (Binary_Ops (J));
  990.          SE (J)  := Op_Node;
  991.          Append_Entity (Make_Formal (Any_Type, "LEFT"),  Op_Node);
  992.          Append_Entity (Make_Formal (Any_Type, "RIGHT"), Op_Node);
  993.       end loop;
  994.  
  995.       for J in S_Unary_Ops loop
  996.          Op_Node := New_Operator (Unary_Ops (J));
  997.          SE (J)  := Op_Node;
  998.          Append_Entity (Make_Formal (Any_Type, "RIGHT"), Op_Node);
  999.       end loop;
  1000.  
  1001.       --  For concatenation, we create a separate operator for each
  1002.       --  array type. This simplifies the resolution of the component-
  1003.       --  component concatenation operation. In Standard, we set the types
  1004.       --  of the formals for string and wide string concatenation.
  1005.  
  1006.       Set_Etype (First_Entity (Standard_Op_Concat),  Standard_String);
  1007.       Set_Etype (Last_Entity  (Standard_Op_Concat),  Standard_String);
  1008.       Set_Etype (Standard_Op_Concat,                 Standard_String);
  1009.  
  1010.       Set_Etype (First_Entity (Standard_Op_Concatw), Standard_Wide_String);
  1011.       Set_Etype (Last_Entity  (Standard_Op_Concatw), Standard_Wide_String);
  1012.       Set_Etype (Standard_Op_Concatw,                Standard_Wide_String);
  1013.  
  1014.    end Create_Operators;
  1015.  
  1016.    -----------------
  1017.    -- Encode_Size --
  1018.    -----------------
  1019.  
  1020.    function Encode_Size (Size : Pos) return Character is
  1021.    begin
  1022.       if Size = 8 then
  1023.          return '1';
  1024.       elsif Size = 16 then
  1025.          return '2';
  1026.       elsif Size = 32 then
  1027.          return '3';
  1028.       elsif Size = 64 then
  1029.          return '4';
  1030.       elsif Size = 128 then
  1031.          return '5';
  1032.       else
  1033.          return '6';
  1034.       end if;
  1035.    end Encode_Size;
  1036.  
  1037.    --------------------
  1038.    -- Identifier_For --
  1039.    --------------------
  1040.  
  1041.    function Identifier_For (S : Standard_Entity_Type) return Node_Id is
  1042.       Ident_Node : Node_Id;
  1043.  
  1044.    begin
  1045.       Ident_Node := New_Node (N_Identifier, Stloc);
  1046.       Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
  1047.       return Ident_Node;
  1048.    end Identifier_For;
  1049.  
  1050.    -----------------
  1051.    -- Make_Formal --
  1052.    -----------------
  1053.  
  1054.    function Make_Formal
  1055.      (Typ         : Entity_Id;
  1056.       Formal_Name : String)
  1057.       return        Entity_Id
  1058.    is
  1059.       Formal : Entity_Id;
  1060.  
  1061.    begin
  1062.       Formal := New_Standard_Entity;
  1063.       Set_Ekind (Formal, E_In_Parameter);
  1064.       Set_Scope (Formal, Standard_Standard);
  1065.       Set_Etype (Formal, Typ);
  1066.       Make_Name (Formal, Formal_Name);
  1067.       return Formal;
  1068.    end Make_Formal;
  1069.  
  1070.    ------------------
  1071.    -- Make_Integer --
  1072.    ------------------
  1073.  
  1074.    function Make_Integer (V : Uint) return Node_Id is
  1075.       N : constant Node_Id := Make_Integer_Literal (Stloc, V);
  1076.  
  1077.    begin
  1078.       Set_Is_Static_Expression (N);
  1079.       return N;
  1080.    end Make_Integer;
  1081.  
  1082.    ---------------
  1083.    -- Make_Name --
  1084.    ---------------
  1085.  
  1086.    procedure Make_Name (Id : Entity_Id; Nam : String) is
  1087.    begin
  1088.       for J in 1 .. Nam'Length loop
  1089.          Name_Buffer (J) := Fold_Lower (Nam (Nam'First + (J - 1)));
  1090.       end loop;
  1091.  
  1092.       Name_Len := Nam'Length;
  1093.       Set_Chars (Id, Name_Find);
  1094.    end Make_Name;
  1095.  
  1096.    ------------------
  1097.    -- New_Operator --
  1098.    ------------------
  1099.  
  1100.    function New_Operator (Op : Name_Id) return Entity_Id is
  1101.       Ident_Node : Entity_Id;
  1102.  
  1103.    begin
  1104.       Ident_Node := Make_Defining_Identifier (Stloc, Op);
  1105.  
  1106.       Set_Is_Pure    (Ident_Node, True);
  1107.       Set_Ekind      (Ident_Node, E_Operator);
  1108.       Set_Etype      (Ident_Node, Universal_Integer);
  1109.       Set_Scope      (Ident_Node, Standard_Standard);
  1110.       Set_Homonym    (Ident_Node, Get_Name_Entity_Id (Op));
  1111.       Set_Convention (Ident_Node, Convention_Intrinsic);
  1112.  
  1113.       Set_Is_Immediately_Visible   (Ident_Node, True);
  1114.       Set_Is_Intrinsic_Subprogram  (Ident_Node, True);
  1115.  
  1116.       Set_Name_Entity_Id (Op, Ident_Node);
  1117.       Append_Entity (Ident_Node, Standard_Standard);
  1118.       return Ident_Node;
  1119.    end New_Operator;
  1120.  
  1121.    -------------------------
  1122.    -- New_Standard_Entity --
  1123.    -------------------------
  1124.  
  1125.    function New_Standard_Entity
  1126.      (New_Node_Kind : Node_Kind := N_Defining_Identifier)
  1127.       return          Entity_Id
  1128.    is
  1129.       E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc);
  1130.  
  1131.    begin
  1132.       Set_Is_Pure (E);
  1133.       Set_Is_Frozen (E);
  1134.       Set_Is_Public (E);
  1135.       return E;
  1136.    end New_Standard_Entity;
  1137.  
  1138.    ----------------------
  1139.    -- Set_Float_Bounds --
  1140.    ----------------------
  1141.  
  1142.    procedure Set_Float_Bounds
  1143.      (Id  : Entity_Id;
  1144.       Typ : Entity_Id)
  1145.    is
  1146.       L   : Node_Id;     --  Low bound of literal value
  1147.       H   : Node_Id;     --  High bound of literal value
  1148.       R   : Node_Id;     --  Range specification
  1149.  
  1150.    begin
  1151.       if Typ = Standard_Short_Float then
  1152.          L := Real_Convert
  1153.                 (Short_Float_Attr_First'Universal_Literal_String);
  1154.          H := Real_Convert
  1155.                 (Short_Float_Attr_Last'Universal_Literal_String);
  1156.  
  1157.       elsif Typ = Standard_Float then
  1158.          L := Real_Convert
  1159.                 (Float_Attr_First'Universal_Literal_String);
  1160.          H := Real_Convert
  1161.                 (Float_Attr_Last'Universal_Literal_String);
  1162.  
  1163.       elsif Typ = Standard_Long_Float then
  1164.          L := Real_Convert
  1165.                 (Long_Float_Attr_First'Universal_Literal_String);
  1166.          H := Real_Convert
  1167.                 (Long_Float_Attr_Last'Universal_Literal_String);
  1168.  
  1169.       elsif Typ = Standard_Long_Long_Float
  1170.         or else Typ = Universal_Real
  1171.       then
  1172.          L := Real_Convert
  1173.                 (Long_Long_Float_Attr_First'Universal_Literal_String);
  1174.          H := Real_Convert
  1175.                 (Long_Long_Float_Attr_Last'Universal_Literal_String);
  1176.  
  1177.       else
  1178.          pragma Assert (False); null;
  1179.       end if;
  1180.  
  1181.       Set_Etype                (L, Typ);
  1182.       Set_Is_Static_Expression (L);
  1183.  
  1184.       Set_Etype                (H, Typ);
  1185.       Set_Is_Static_Expression (H);
  1186.  
  1187.       R := New_Node (N_Range, Stloc);
  1188.       Set_Low_Bound  (R, L);
  1189.       Set_High_Bound (R, H);
  1190.       Set_Scalar_Range (Id, R);
  1191.    end Set_Float_Bounds;
  1192.  
  1193.    ------------------------
  1194.    -- Set_Integer_Bounds --
  1195.    ------------------------
  1196.  
  1197.    procedure Set_Integer_Bounds
  1198.      (Id  : Entity_Id;
  1199.       Typ : Entity_Id;
  1200.       Lb  : Uint;
  1201.       Hb  : Uint)
  1202.    is
  1203.       L : Node_Id;     -- Low bound of literal value
  1204.       H : Node_Id;     -- High bound of literal value
  1205.       R : Node_Id;     -- Range specification
  1206.  
  1207.    begin
  1208.       L := Make_Integer (Lb);
  1209.       H := Make_Integer (Hb);
  1210.  
  1211.       Set_Etype (L, Typ);
  1212.       Set_Etype (H, Typ);
  1213.  
  1214.       R := New_Node (N_Range, Stloc);
  1215.       Set_Low_Bound  (R, L);
  1216.       Set_High_Bound (R, H);
  1217.       Set_Scalar_Range (Id, R);
  1218.    end Set_Integer_Bounds;
  1219.  
  1220. end CStand;
  1221.