-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 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. --
-- 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.
+ -- 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;
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_Is_Known_Valid (Standard_Character);
Set_Size_Known_At_Compile_Time (Standard_Character);
- -- Create the bounds for type Character.
+ -- Create the bounds for type Character
R_Node := New_Node (N_Range, Stloc);
Set_Is_Known_Valid (Standard_Wide_Character);
Set_Size_Known_At_Compile_Time (Standard_Wide_Character);
- -- Create the bounds for type Wide_Character.
+ -- Create the bounds for type Wide_Character
R_Node := New_Node (N_Range, Stloc);
Set_Is_Character_Type (Standard_Wide_Wide_Character);
Set_Is_Known_Valid (Standard_Wide_Wide_Character);
Set_Size_Known_At_Compile_Time (Standard_Wide_Wide_Character);
- Set_Is_Ada_2005 (Standard_Wide_Wide_Character);
+ Set_Is_Ada_2005_Only (Standard_Wide_Wide_Character);
-- Create the bounds for type Wide_Wide_Character
Init_Size_Align (Standard_String);
Set_Alignment (Standard_String, Uint_1);
+ -- On targets where a storage unit is larger than a byte (such as AAMP),
+ -- pragma Pack has a real effect on the representation of type String,
+ -- and the type must be marked as having a nonstandard representation.
+
+ if System_Storage_Unit > Uint_8 then
+ Set_Has_Non_Standard_Rep (Standard_String);
+ Set_Has_Pragma_Pack (Standard_String);
+ end if;
+
-- Set index type of String
E_Id := First
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
- Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
- Set_Etype (Standard_Wide_Wide_String,
- Standard_Wide_Wide_String);
- Set_Component_Type (Standard_Wide_Wide_String,
- Standard_Wide_Wide_Character);
- Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
- Init_Size_Align (Standard_Wide_Wide_String);
- Set_Is_Ada_2005 (Standard_Wide_Wide_String);
+ Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
+ Set_Etype (Standard_Wide_Wide_String,
+ Standard_Wide_Wide_String);
+ Set_Component_Type (Standard_Wide_Wide_String,
+ Standard_Wide_Wide_Character);
+ Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
+ Init_Size_Align (Standard_Wide_Wide_String);
+ Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
-- Set index type of Wide_Wide_String
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));
(Standard_Exception_Type, True);
Make_Name (Standard_Exception_Type, "exception");
- Make_Component (Standard_Exception_Type, Standard_Boolean,
- "Not_Handled_By_Others");
- Make_Component (Standard_Exception_Type, Standard_Character, "Lang");
- Make_Component (Standard_Exception_Type, Standard_Natural,
- "Name_Length");
- Make_Component (Standard_Exception_Type, Standard_A_Char,
- "Full_Name");
- Make_Component (Standard_Exception_Type, Standard_A_Char,
- "HTable_Ptr");
- Make_Component (Standard_Exception_Type, Standard_Unsigned,
- "Import_Code");
- Make_Component (Standard_Exception_Type, Standard_A_Char,
- "Raise_Hook");
- -- Build tree for record declaration, for use by the back-end.
+ Make_Component
+ (Standard_Exception_Type, Standard_Boolean, "Not_Handled_By_Others");
+ Make_Component
+ (Standard_Exception_Type, Standard_Character, "Lang");
+ Make_Component
+ (Standard_Exception_Type, Standard_Natural, "Name_Length");
+ Make_Component
+ (Standard_Exception_Type, Standard_A_Char, "Full_Name");
+ Make_Component
+ (Standard_Exception_Type, Standard_A_Char, "HTable_Ptr");
+ Make_Component
+ (Standard_Exception_Type, Standard_Unsigned, "Import_Code");
+ Make_Component
+ (Standard_Exception_Type, Standard_A_Char, "Raise_Hook");
+
+ -- Build tree for record declaration, for use by the back-end
declare
Comp_List : List_Id;
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
