-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- 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 2, or (at your option) any later ver- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- 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. --
Set_Is_Pure (Standard_Standard);
Set_Is_Compilation_Unit (Standard_Standard);
- -- Create type declaration nodes for standard types
+ -- Create type/subtype declaration nodes for standard types
for S in S_Types loop
- Decl := New_Node (N_Full_Type_Declaration, Stloc);
- Set_Defining_Identifier (Decl, Standard_Entity (S));
+
+ -- 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;
-- range False .. True
-- where the occurrences of the literals must point to the
- -- corresponding definition.
+ -- corresponding definition.
R_Node := New_Node (N_Range, Stloc);
B_Node := New_Node (N_Identifier, Stloc);
Set_Entity (E_Id, Standard_Positive);
Set_Etype (E_Id, Standard_Positive);
- -- Create subtype declaration for Natural
-
- Decl := New_Node (N_Subtype_Declaration, Stloc);
- Set_Defining_Identifier (Decl, Standard_Natural);
- Set_Subtype_Indication (Decl,
- New_Occurrence_Of (Standard_Integer, Stloc));
- Append (Decl, Decl_S);
+ -- Setup entity for Naturalend Create_Standard;
Set_Ekind (Standard_Natural, E_Signed_Integer_Subtype);
Set_Etype (Standard_Natural, Base_Type (Standard_Integer));
Lb => Uint_0,
Hb => Intval (High_Bound (Scalar_Range (Standard_Integer))));
Set_Is_Constrained (Standard_Natural);
- Set_Is_Frozen (Standard_Natural);
- Set_Is_Public (Standard_Natural);
-
- -- Create subtype declaration for Positive
- Decl := New_Node (N_Subtype_Declaration, Stloc);
- Set_Defining_Identifier (Decl, Standard_Positive);
- Set_Subtype_Indication (Decl,
- New_Occurrence_Of (Standard_Integer, Stloc));
- Append (Decl, Decl_S);
+ -- Setup entity for Positive
Set_Ekind (Standard_Positive, E_Signed_Integer_Subtype);
Set_Etype (Standard_Positive, Base_Type (Standard_Integer));
Lb => Uint_1,
Hb => Intval (High_Bound (Scalar_Range (Standard_Integer))));
Set_Is_Constrained (Standard_Positive);
- Set_Is_Frozen (Standard_Positive);
- Set_Is_Public (Standard_Positive);
-- Create declaration for package ASCII
Set_Directly_Designated_Type (Standard_A_Char, Standard_Character);
Make_Name (Standard_A_Char, "access_character");
+ -- Standard_Debug_Renaming_Type is used for the special objects created
+ -- to encode the names occurring in renaming declarations for use by the
+ -- debugger (see exp_dbug.adb). The type is a zero-sized subtype of
+ -- Standard.Integer.
+
+ Standard_Debug_Renaming_Type := New_Standard_Entity;
+
+ Set_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype);
+ Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard);
+ Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer));
+ Init_Esize (Standard_Debug_Renaming_Type, 0);
+ Init_RM_Size (Standard_Debug_Renaming_Type, 0);
+ Set_Size_Known_At_Compile_Time (Standard_Debug_Renaming_Type);
+ Set_Integer_Bounds (Standard_Debug_Renaming_Type,
+ Typ => Base_Type (Standard_Debug_Renaming_Type),
+ Lb => Uint_1,
+ Hb => Uint_0);
+ Set_Is_Constrained (Standard_Debug_Renaming_Type);
+ Set_Has_Size_Clause (Standard_Debug_Renaming_Type);
+
+ Make_Name (Standard_Debug_Renaming_Type, "_renaming_type");
+
-- Note on type names. The type names for the following special types
-- are constructed so that they will look reasonable should they ever
-- appear in error messages etc, although in practice the use of the
Set_Ekind (Any_Id, E_Variable);
Set_Scope (Any_Id, Standard_Standard);
Set_Etype (Any_Id, Any_Type);
- Init_Size_Align (Any_Id);
+ Init_Esize (Any_Id);
+ Init_Alignment (Any_Id);
Make_Name (Any_Id, "any id");
Any_Access := New_Standard_Entity;
Set_Is_Unsigned_Type (Standard_Unsigned);
Set_Size_Known_At_Compile_Time
(Standard_Unsigned);
+ Set_Is_Known_Valid (Standard_Unsigned, True);
R_Node := New_Node (N_Range, Stloc);
Set_Low_Bound (R_Node, Make_Integer (Uint_0));
begin
Comp := First_Entity (Standard_Exception_Type);
Comp_List := New_List;
-
while Present (Comp) loop
Append (
Make_Component_Declaration (Stloc,
function Identifier_For (S : Standard_Entity_Type) return Node_Id is
Ident_Node : Node_Id;
-
begin
Ident_Node := New_Node (N_Identifier, Stloc);
Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
Write_Eol;
P ("package Standard is");
- P ("pragma Pure(Standard);");
+ P ("pragma Pure (Standard);");
Write_Eol;
P (" type Boolean is (False, True);");
Write_Eol;
P (" type Wide_Wide_Character is (...)");
- Write_Str (" for Wide_Character'Size use ");
+ Write_Str (" for Wide_Wide_Character'Size use ");
Write_Int (Standard_Wide_Wide_Character_Size);
P (";");
P (" -- See RM A.1(36) for details of this type");
OSDN Git Service
