-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-2002 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, 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. --
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
+with Output; use Output;
+with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Ttypef; use Ttypef;
+with Scn;
with Sem_Mech; use Sem_Mech;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
function Make_Formal
(Typ : Entity_Id;
- Formal_Name : String)
- return 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;
-- 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;
+ (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;
-- Builds a new entity for Standard
+ procedure Print_Standard;
+ -- Print representation of package Standard if switch set
+
procedure Set_Integer_Bounds
(Id : Entity_Id;
Typ : Entity_Id;
Set_Ekind (E, E_Floating_Point_Type);
Set_Etype (E, E);
Init_Size (E, Siz);
- Set_Prim_Alignment (E);
+ Set_Elem_Alignment (E);
Init_Digits_Value (E, Digs);
Set_Float_Bounds (E);
Set_Is_Frozen (E);
Set_Ekind (E, E_Signed_Integer_Type);
Set_Etype (E, E);
Init_Size (E, Siz);
- Set_Prim_Alignment (E);
+ Set_Elem_Alignment (E);
Set_Integer_Bounds (E, E, Lbound, Ubound);
Set_Is_Frozen (E);
Set_Is_Public (E);
procedure Create_Operators is
Op_Node : Entity_Id;
- -- Following list has two entries for concatenation, to include
- -- explicitly the operation on wide strings.
+ -- The following tables define the binary and unary operators and their
+ -- corresponding result type.
Binary_Ops : constant array (S_Binary_Ops) of Name_Id :=
- (Name_Op_Add, Name_Op_And, 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);
+
+ -- 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 :=
- (Universal_Integer, Standard_Boolean,
- Standard_String, Standard_Wide_String,
- Universal_Integer, Standard_Boolean,
- Universal_Integer, Standard_Boolean,
- Standard_Boolean, Standard_Boolean,
- Standard_Boolean, Universal_Integer,
- Universal_Integer, Standard_Boolean,
- Standard_Boolean, Universal_Integer,
- Universal_Integer, Standard_Boolean);
+
+ -- 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 :=
- (Name_Op_Abs, Name_Op_Subtract, Name_Op_Not, Name_Op_Add);
+
+ -- 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 :=
- (Universal_Integer, Universal_Integer,
- Standard_Boolean, Universal_Integer);
- -- Corresponding to Abs, Minus, Not, and Plus.
+ -- 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
-- 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 and wide string concatenation.
+ -- 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;
---------------------
-- by Initialize_Standard in the semantics module.
procedure Create_Standard is
- Decl_S : List_Id;
+ Decl_S : constant List_Id := New_List;
-- List of declarations in Standard
- Decl_A : List_Id;
+ Decl_A : constant List_Id := New_List;
-- List of declarations in ASCII
Decl : Node_Id;
-- Start of processing for Create_Standard
begin
- Decl_S := New_List;
+ -- 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
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;
Set_Etype (Standard_Boolean, Standard_Boolean);
Init_Esize (Standard_Boolean, Standard_Character_Size);
Init_RM_Size (Standard_Boolean, 1);
- Set_Prim_Alignment (Standard_Boolean);
+ Set_Elem_Alignment (Standard_Boolean);
Set_Is_Unsigned_Type (Standard_Boolean);
Set_Size_Known_At_Compile_Time (Standard_Boolean);
-- 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_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
declare
LIS : Nat;
-
begin
if Debug_Flag_M then
LIS := 64;
Set_Etype (Standard_Character, Standard_Character);
Init_Esize (Standard_Character, Standard_Character_Size);
Init_RM_Size (Standard_Character, 8);
- Set_Prim_Alignment (Standard_Character);
+ Set_Elem_Alignment (Standard_Character);
Set_Is_Unsigned_Type (Standard_Character);
Set_Is_Character_Type (Standard_Character);
Set_Is_Known_Valid (Standard_Character);
Set_Size_Known_At_Compile_Time (Standard_Character);
- -- Create the bounds for type Character.
+ -- Create the bounds for type Character
R_Node := New_Node (N_Range, Stloc);
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, 16#00#);
- Set_Entity (B_Node, Empty);
+ 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);
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, 16#FF#);
- Set_Entity (B_Node, Empty);
+ 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_Etype (Standard_Wide_Character, Standard_Wide_Character);
Init_Size (Standard_Wide_Character, Standard_Wide_Character_Size);
- Set_Prim_Alignment (Standard_Wide_Character);
+ Set_Elem_Alignment (Standard_Wide_Character);
Set_Is_Unsigned_Type (Standard_Wide_Character);
Set_Is_Character_Type (Standard_Wide_Character);
Set_Is_Known_Valid (Standard_Wide_Character);
Set_Size_Known_At_Compile_Time (Standard_Wide_Character);
- -- Create the bounds for type Wide_Character.
+ -- Create the bounds for type Wide_Character
R_Node := New_Node (N_Range, Stloc);
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, 16#0000#);
- Set_Entity (B_Node, Empty);
+ 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);
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, 16#FFFF#);
- Set_Entity (B_Node, Empty);
+ 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_Etype (R_Node, Standard_Wide_Character);
Set_Parent (R_Node, Standard_Wide_Character);
+ -- Create type definition for type Wide_Wide_Character. Note that we
+ -- do not set the Literals field, since type Wide_Wide_Character is
+ -- handled with special routines that do not need a literal list.
+
+ Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
+ Set_Type_Definition (Parent (Standard_Wide_Wide_Character), Tdef_Node);
+
+ Set_Ekind (Standard_Wide_Wide_Character, E_Enumeration_Type);
+ Set_Etype (Standard_Wide_Wide_Character,
+ Standard_Wide_Wide_Character);
+ Init_Size (Standard_Wide_Wide_Character,
+ Standard_Wide_Wide_Character_Size);
+
+ Set_Elem_Alignment (Standard_Wide_Wide_Character);
+ Set_Is_Unsigned_Type (Standard_Wide_Wide_Character);
+ Set_Is_Character_Type (Standard_Wide_Wide_Character);
+ Set_Is_Known_Valid (Standard_Wide_Wide_Character);
+ Set_Size_Known_At_Compile_Time (Standard_Wide_Wide_Character);
+ Set_Is_Ada_2005_Only (Standard_Wide_Wide_Character);
+
+ -- Create the bounds for type Wide_Wide_Character
+
+ R_Node := New_Node (N_Range, Stloc);
+
+ -- Low bound for type Wide_Wide_Character
+
+ B_Node := New_Node (N_Character_Literal, Stloc);
+ Set_Is_Static_Expression (B_Node);
+ Set_Chars (B_Node, No_Name); -- ???
+ Set_Char_Literal_Value (B_Node, Uint_0);
+ Set_Entity (B_Node, Empty);
+ Set_Etype (B_Node, Standard_Wide_Wide_Character);
+ Set_Low_Bound (R_Node, B_Node);
+
+ -- High bound for type Wide_Wide_Character
+
+ B_Node := New_Node (N_Character_Literal, Stloc);
+ Set_Is_Static_Expression (B_Node);
+ Set_Chars (B_Node, No_Name); -- ???
+ Set_Char_Literal_Value (B_Node, UI_From_Int (16#7FFF_FFFF#));
+ Set_Entity (B_Node, Empty);
+ Set_Etype (B_Node, Standard_Wide_Wide_Character);
+ Set_High_Bound (R_Node, B_Node);
+
+ Set_Scalar_Range (Standard_Wide_Wide_Character, R_Node);
+ Set_Etype (R_Node, Standard_Wide_Wide_Character);
+ Set_Parent (R_Node, Standard_Wide_Wide_Character);
+
-- Create type definition node for type String
Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
- Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Character));
+
+ declare
+ CompDef_Node : Node_Id;
+ begin
+ CompDef_Node := New_Node (N_Component_Definition, Stloc);
+ Set_Aliased_Present (CompDef_Node, False);
+ Set_Access_Definition (CompDef_Node, Empty);
+ Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character));
+ Set_Component_Definition (Tdef_Node, CompDef_Node);
+ end;
+
Set_Subtype_Marks (Tdef_Node, New_List);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);
Set_Component_Type (Standard_String, Standard_Character);
Set_Component_Size (Standard_String, Uint_8);
Init_Size_Align (Standard_String);
+ Set_Alignment (Standard_String, Uint_1);
+
+ -- On targets where a storage unit is larger than a byte (such as AAMP),
+ -- pragma Pack has a real effect on the representation of type String,
+ -- and the type must be marked as having a nonstandard representation.
+
+ if System_Storage_Unit > Uint_8 then
+ Set_Has_Non_Standard_Rep (Standard_String);
+ Set_Has_Pragma_Pack (Standard_String);
+ end if;
-- Set index type of String
-- Create type definition node for type Wide_String
Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
- Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Wide_Character));
+
+ declare
+ CompDef_Node : Node_Id;
+ begin
+ CompDef_Node := New_Node (N_Component_Definition, Stloc);
+ Set_Aliased_Present (CompDef_Node, False);
+ Set_Access_Definition (CompDef_Node, Empty);
+ Set_Subtype_Indication (CompDef_Node,
+ Identifier_For (S_Wide_Character));
+ Set_Component_Definition (Tdef_Node, CompDef_Node);
+ end;
+
Set_Subtype_Marks (Tdef_Node, New_List);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
Set_Entity (E_Id, Standard_Positive);
Set_Etype (E_Id, Standard_Positive);
- -- Create subtype declaration for Natural
+ -- Create type definition node for type Wide_Wide_String
- 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);
+ Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
+
+ declare
+ CompDef_Node : Node_Id;
+ begin
+ CompDef_Node := New_Node (N_Component_Definition, Stloc);
+ Set_Aliased_Present (CompDef_Node, False);
+ Set_Access_Definition (CompDef_Node, Empty);
+ Set_Subtype_Indication (CompDef_Node,
+ Identifier_For (S_Wide_Wide_Character));
+ Set_Component_Definition (Tdef_Node, CompDef_Node);
+ end;
+
+ Set_Subtype_Marks (Tdef_Node, New_List);
+ Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
+ Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
+
+ Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
+ Set_Etype (Standard_Wide_Wide_String,
+ Standard_Wide_Wide_String);
+ Set_Component_Type (Standard_Wide_Wide_String,
+ Standard_Wide_Wide_Character);
+ Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
+ Init_Size_Align (Standard_Wide_Wide_String);
+ Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
+
+ -- Set index type of Wide_Wide_String
+
+ E_Id := First
+ (Subtype_Marks (Type_Definition (Parent (Standard_Wide_Wide_String))));
+ Set_First_Index (Standard_Wide_Wide_String, E_Id);
+ Set_Entity (E_Id, Standard_Positive);
+ Set_Etype (E_Id, Standard_Positive);
+
+ -- Setup entity for Naturalend Create_Standard;
Set_Ekind (Standard_Natural, E_Signed_Integer_Subtype);
Set_Etype (Standard_Natural, Base_Type (Standard_Integer));
Init_Esize (Standard_Natural, Standard_Integer_Size);
Init_RM_Size (Standard_Natural, Standard_Integer_Size - 1);
- Set_Prim_Alignment (Standard_Natural);
+ Set_Elem_Alignment (Standard_Natural);
Set_Size_Known_At_Compile_Time
(Standard_Natural);
Set_Integer_Bounds (Standard_Natural,
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));
Init_Esize (Standard_Positive, Standard_Integer_Size);
Init_RM_Size (Standard_Positive, Standard_Integer_Size - 1);
- Set_Prim_Alignment (Standard_Positive);
+ Set_Elem_Alignment (Standard_Positive);
Set_Size_Known_At_Compile_Time (Standard_Positive);
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_Defining_Unit_Name (Pspec, Standard_Entity (S_ASCII));
Set_Ekind (Standard_Entity (S_ASCII), E_Package);
- Decl_A := New_List; -- for ASCII declarations
Set_Visible_Declarations (Pspec, Decl_A);
-- Create control character definitions in package ASCII. Note that
Set_Constant_Present (Decl, True);
declare
- A_Char : Entity_Id := Standard_Entity (S);
+ A_Char : constant Entity_Id := Standard_Entity (S);
Expr_Decl : Node_Id;
begin
Set_Sloc (A_Char, Staloc);
Set_Ekind (A_Char, E_Constant);
- Set_Not_Source_Assigned (A_Char, True);
+ Set_Never_Set_In_Source (A_Char, True);
Set_Is_True_Constant (A_Char, True);
Set_Etype (A_Char, Standard_Character);
Set_Scope (A_Char, Standard_Entity (S_ASCII));
Set_Is_Static_Expression (Expr_Decl);
Set_Chars (Expr_Decl, No_Name);
Set_Etype (Expr_Decl, Standard_Character);
- Set_Char_Literal_Value (Expr_Decl, Ccode);
+ Set_Char_Literal_Value (Expr_Decl, UI_From_Int (Int (Ccode)));
end;
Append (Decl, Decl_A);
Standard_Void_Type := New_Standard_Entity;
Set_Ekind (Standard_Void_Type, E_Void);
Set_Etype (Standard_Void_Type, Standard_Void_Type);
- Init_Size_Align (Standard_Void_Type);
Set_Scope (Standard_Void_Type, Standard_Standard);
Make_Name (Standard_Void_Type, "_void_type");
Set_Scope (Standard_A_Char, Standard_Standard);
Set_Etype (Standard_A_Char, Standard_A_String);
Init_Size (Standard_A_Char, System_Address_Size);
- Set_Prim_Alignment (Standard_A_Char);
+ Set_Elem_Alignment (Standard_A_Char);
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_Scope (Any_Access, Standard_Standard);
Set_Etype (Any_Access, Any_Access);
Init_Size (Any_Access, System_Address_Size);
- Set_Prim_Alignment (Any_Access);
+ Set_Elem_Alignment (Any_Access);
Make_Name (Any_Access, "an access type");
+ Any_Character := New_Standard_Entity;
+ Set_Ekind (Any_Character, E_Enumeration_Type);
+ Set_Scope (Any_Character, Standard_Standard);
+ Set_Etype (Any_Character, Any_Character);
+ Set_Is_Unsigned_Type (Any_Character);
+ Set_Is_Character_Type (Any_Character);
+ Init_Esize (Any_Character, Standard_Character_Size);
+ Init_RM_Size (Any_Character, 8);
+ Set_Elem_Alignment (Any_Character);
+ Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
+ Make_Name (Any_Character, "a character type");
+
Any_Array := New_Standard_Entity;
Set_Ekind (Any_Array, E_String_Type);
Set_Scope (Any_Array, Standard_Standard);
Set_Etype (Any_Boolean, Standard_Boolean);
Init_Esize (Any_Boolean, Standard_Character_Size);
Init_RM_Size (Any_Boolean, 1);
- Set_Prim_Alignment (Any_Boolean);
+ Set_Elem_Alignment (Any_Boolean);
Set_Is_Unsigned_Type (Any_Boolean);
Set_Scalar_Range (Any_Boolean, Scalar_Range (Standard_Boolean));
Make_Name (Any_Boolean, "a boolean type");
- Any_Character := New_Standard_Entity;
- Set_Ekind (Any_Character, E_Enumeration_Type);
- Set_Scope (Any_Character, Standard_Standard);
- Set_Etype (Any_Character, Any_Character);
- Set_Is_Unsigned_Type (Any_Character);
- Set_Is_Character_Type (Any_Character);
- Init_Esize (Any_Character, Standard_Character_Size);
- Init_RM_Size (Any_Character, 8);
- Set_Prim_Alignment (Any_Character);
- Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
- Make_Name (Any_Character, "a character type");
-
Any_Composite := New_Standard_Entity;
Set_Ekind (Any_Composite, E_Array_Type);
Set_Scope (Any_Composite, Standard_Standard);
Set_Scope (Any_Discrete, Standard_Standard);
Set_Etype (Any_Discrete, Any_Discrete);
Init_Size (Any_Discrete, Standard_Integer_Size);
- Set_Prim_Alignment (Any_Discrete);
+ Set_Elem_Alignment (Any_Discrete);
Make_Name (Any_Discrete, "a discrete type");
Any_Fixed := New_Standard_Entity;
Set_Scope (Any_Fixed, Standard_Standard);
Set_Etype (Any_Fixed, Any_Fixed);
Init_Size (Any_Fixed, Standard_Integer_Size);
- Set_Prim_Alignment (Any_Fixed);
+ Set_Elem_Alignment (Any_Fixed);
Make_Name (Any_Fixed, "a fixed-point type");
Any_Integer := New_Standard_Entity;
Set_Scope (Any_Integer, Standard_Standard);
Set_Etype (Any_Integer, Standard_Long_Long_Integer);
Init_Size (Any_Integer, Standard_Long_Long_Integer_Size);
- Set_Prim_Alignment (Any_Integer);
+ Set_Elem_Alignment (Any_Integer);
Set_Integer_Bounds
(Any_Integer,
Set_Scope (Any_Modular, Standard_Standard);
Set_Etype (Any_Modular, Standard_Long_Long_Integer);
Init_Size (Any_Modular, Standard_Long_Long_Integer_Size);
- Set_Prim_Alignment (Any_Modular);
+ Set_Elem_Alignment (Any_Modular);
Set_Is_Unsigned_Type (Any_Modular);
Make_Name (Any_Modular, "a modular type");
Set_Scope (Any_Numeric, Standard_Standard);
Set_Etype (Any_Numeric, Standard_Long_Long_Integer);
Init_Size (Any_Numeric, Standard_Long_Long_Integer_Size);
- Set_Prim_Alignment (Any_Numeric);
+ Set_Elem_Alignment (Any_Numeric);
Make_Name (Any_Numeric, "a numeric type");
Any_Real := New_Standard_Entity;
Set_Scope (Any_Real, Standard_Standard);
Set_Etype (Any_Real, Standard_Long_Long_Float);
Init_Size (Any_Real, Standard_Long_Long_Float_Size);
- Set_Prim_Alignment (Any_Real);
+ Set_Elem_Alignment (Any_Real);
Make_Name (Any_Real, "a real type");
Any_Scalar := New_Standard_Entity;
Set_Scope (Any_Scalar, Standard_Standard);
Set_Etype (Any_Scalar, Any_Scalar);
Init_Size (Any_Scalar, Standard_Integer_Size);
- Set_Prim_Alignment (Any_Scalar);
+ Set_Elem_Alignment (Any_Scalar);
Make_Name (Any_Scalar, "a scalar type");
Any_String := New_Standard_Entity;
declare
Index : Node_Id;
- Indexes : List_Id;
begin
Index :=
Make_Range (Stloc,
Low_Bound => Make_Integer (Uint_0),
High_Bound => Make_Integer (Uint_2 ** Standard_Integer_Size));
- Indexes := New_List (Index);
Set_Etype (Index, Standard_Integer);
Set_First_Index (Any_String, Index);
end;
Set_Scope (Standard_Unsigned, Standard_Standard);
Set_Etype (Standard_Unsigned, Standard_Unsigned);
Init_Size (Standard_Unsigned, Standard_Integer_Size);
- Set_Prim_Alignment (Standard_Unsigned);
+ Set_Elem_Alignment (Standard_Unsigned);
Set_Modulus (Standard_Unsigned,
Uint_2 ** Standard_Integer_Size);
-
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_Literal (Stloc, 0));
- Set_High_Bound (R_Node,
- Make_Integer_Literal (Stloc, Modulus (Standard_Unsigned)));
+ Set_Low_Bound (R_Node, Make_Integer (Uint_0));
+ Set_High_Bound (R_Node, Make_Integer (Modulus (Standard_Unsigned) - 1));
+ Set_Etype (Low_Bound (R_Node), Standard_Unsigned);
+ Set_Etype (High_Bound (R_Node), Standard_Unsigned);
Set_Scalar_Range (Standard_Unsigned, R_Node);
-- Note: universal integer and universal real are constructed as fully
Set_Etype (Universal_Fixed, Universal_Fixed);
Set_Scope (Universal_Fixed, Standard_Standard);
Init_Size (Universal_Fixed, Standard_Long_Long_Integer_Size);
- Set_Prim_Alignment (Universal_Fixed);
+ Set_Elem_Alignment (Universal_Fixed);
Set_Size_Known_At_Compile_Time
(Universal_Fixed);
-- Create type declaration for Duration, using a 64-bit size. The
- -- delta value depends on the mode we are running in:
-
- -- Normal mode or No_Run_Time mode when word size is 64 bits:
- -- 10**(-9) seconds, size is 64 bits
-
- -- No_Run_Time mode when word size is 32 bits:
- -- 10**(-4) seconds, oize is 32 bits
+ -- delta and size values depend on the mode set in system.ads.
Build_Duration : declare
- Dlo : Uint;
- Dhi : Uint;
- Delta_Val : Ureal;
- Use_32_Bits : constant Boolean :=
- No_Run_Time and then System_Word_Size = 32;
+ Dlo : Uint;
+ Dhi : Uint;
+ Delta_Val : Ureal;
begin
- if Use_32_Bits then
+ -- In 32 bit mode, the size is 32 bits, and the delta and
+ -- small values are set to 20 milliseconds (20.0**(10.0**(-3)).
+
+ if Duration_32_Bits_On_Target then
Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
Dhi := Intval (Type_High_Bound (Standard_Integer_32));
- Delta_Val := UR_From_Components (Uint_1, Uint_4, 10);
+ Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10);
+
+ -- In standard 64-bit mode, the size is 64-bits and the delta and
+ -- small values are set to nanoseconds (1.0**(10.0**(-9))
else
Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
Delta_Val := UR_From_Components (Uint_1, Uint_9, 10);
end if;
- Decl :=
- Make_Full_Type_Declaration (Stloc,
- Defining_Identifier => Standard_Duration,
- Type_Definition =>
- Make_Ordinary_Fixed_Point_Definition (Stloc,
+ Tdef_Node := Make_Ordinary_Fixed_Point_Definition (Stloc,
Delta_Expression => Make_Real_Literal (Stloc, Delta_Val),
Real_Range_Specification =>
Make_Real_Range_Specification (Stloc,
Low_Bound => Make_Real_Literal (Stloc,
Realval => Dlo * Delta_Val),
High_Bound => Make_Real_Literal (Stloc,
- Realval => Dhi * Delta_Val))));
+ Realval => Dhi * Delta_Val)));
+
+ Set_Type_Definition (Parent (Standard_Duration), Tdef_Node);
Set_Ekind (Standard_Duration, E_Ordinary_Fixed_Point_Type);
Set_Etype (Standard_Duration, Standard_Duration);
- if Use_32_Bits then
+ if Duration_32_Bits_On_Target then
Init_Size (Standard_Duration, 32);
else
Init_Size (Standard_Duration, 64);
end if;
- Set_Prim_Alignment (Standard_Duration);
+ Set_Elem_Alignment (Standard_Duration);
Set_Delta_Value (Standard_Duration, Delta_Val);
Set_Small_Value (Standard_Duration, Delta_Val);
Set_Scalar_Range (Standard_Duration,
Real_Range_Specification
- (Type_Definition (Decl)));
+ (Type_Definition (Parent (Standard_Duration))));
-- Normally it does not matter that nodes in package Standard are
-- not marked as analyzed. The Scalar_Range of the fixed-point
-- Build standard exception type. Note that the type name here is
-- actually used in the generated code, so it must be set correctly
+ -- ??? Also note that the Import_Code component is now declared
+ -- as a System.Standard_Library.Exception_Code to enforce run-time
+ -- library implementation consistency. It's too early here to resort
+ -- to rtsfind to get the proper node for that type, so we use the
+ -- closest possible available type node at hand instead. We should
+ -- probably be fixing this up at some point.
+
Standard_Exception_Type := New_Standard_Entity;
Set_Ekind (Standard_Exception_Type, E_Record_Type);
Set_Etype (Standard_Exception_Type, Standard_Exception_Type);
Set_Scope (Standard_Exception_Type, Standard_Standard);
- Set_Girder_Constraint
+ Set_Stored_Constraint
(Standard_Exception_Type, No_Elist);
Init_Size_Align (Standard_Exception_Type);
Set_Size_Known_At_Compile_Time
(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_Integer,
- "Import_Code");
-
- -- 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,
Defining_Identifier => Comp,
- Subtype_Indication => New_Occurrence_Of (Etype (Comp), Stloc)),
+ Component_Definition =>
+ Make_Component_Definition (Stloc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Occurrence_Of (Etype (Comp),
+ Stloc))),
Comp_List);
Next_Entity (Comp);
Append (Decl, Decl_S);
+ Layout_Type (Standard_Exception_Type);
+
-- Create declarations of standard exceptions
Build_Exception (S_Constraint_Error);
Build_Exception (S_Tasking_Error);
-- Numeric_Error is a normal exception in Ada 83, but in Ada 95
- -- it is a renaming of Constraint_Error
+ -- it is a renaming of Constraint_Error. Is this test too early???
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Build_Exception (S_Numeric_Error);
else
-- The Error node has an Etype of Any_Type to help error recovery
Set_Etype (Error, Any_Type);
+
+ -- Print representation of standard if switch set
+
+ if Opt.Print_Standard then
+ Print_Standard;
+ end if;
end Create_Standard;
------------------------------------
New_Ent : constant Entity_Id := New_Copy (E);
begin
- Set_Ekind (E, K);
- Set_Is_Constrained (E, True);
- Set_Etype (E, New_Ent);
+ Set_Ekind (E, K);
+ Set_Is_Constrained (E, True);
+ Set_Is_First_Subtype (E, True);
+ Set_Etype (E, New_Ent);
Append_Entity (New_Ent, Standard_Standard);
Set_Is_Constrained (New_Ent, False);
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)));
Typ : Entity_Id;
Nam : String)
is
- Id : Entity_Id := New_Standard_Entity;
+ Id : constant Entity_Id := New_Standard_Entity;
begin
Set_Ekind (Id, E_Component);
function Make_Formal
(Typ : Entity_Id;
- Formal_Name : String)
- return Entity_Id
+ Formal_Name : String) return Entity_Id
is
Formal : Entity_Id;
function Make_Integer (V : Uint) return Node_Id is
N : constant Node_Id := Make_Integer_Literal (Stloc, V);
-
begin
Set_Is_Static_Expression (N);
return N;
-------------------------
function New_Standard_Entity
- (New_Node_Kind : Node_Kind := N_Defining_Identifier)
- return Entity_Id
+ (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id
is
E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc);
return E;
end New_Standard_Entity;
+ --------------------
+ -- Print_Standard --
+ --------------------
+
+ procedure Print_Standard is
+
+ procedure P (Item : String) renames Output.Write_Line;
+ -- Short-hand, since we do a lot of line writes here!
+
+ procedure P_Int_Range (Size : Pos);
+ -- Prints the range of an integer based on its Size
+
+ procedure P_Float_Range (Id : Entity_Id);
+ -- Prints the bounds range for the given float type entity
+
+ -------------------
+ -- P_Float_Range --
+ -------------------
+
+ procedure P_Float_Range (Id : Entity_Id) is
+ Digs : constant Nat := UI_To_Int (Digits_Value (Id));
+
+ begin
+ Write_Str (" range ");
+
+ if Vax_Float (Id) then
+ if Digs = VAXFF_Digits then
+ Write_Str (VAXFF_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (VAXFF_Last'Universal_Literal_String);
+
+ elsif Digs = VAXDF_Digits then
+ Write_Str (VAXDF_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (VAXDF_Last'Universal_Literal_String);
+
+ else
+ pragma Assert (Digs = VAXGF_Digits);
+
+ Write_Str (VAXGF_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (VAXGF_Last'Universal_Literal_String);
+ end if;
+
+ elsif Is_AAMP_Float (Id) then
+ if Digs = AAMPS_Digits then
+ Write_Str (AAMPS_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (AAMPS_Last'Universal_Literal_String);
+
+ else
+ pragma Assert (Digs = AAMPL_Digits);
+ Write_Str (AAMPL_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (AAMPL_Last'Universal_Literal_String);
+ end if;
+
+ elsif Digs = IEEES_Digits then
+ Write_Str (IEEES_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (IEEES_Last'Universal_Literal_String);
+
+ elsif Digs = IEEEL_Digits then
+ Write_Str (IEEEL_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (IEEEL_Last'Universal_Literal_String);
+
+ else
+ pragma Assert (Digs = IEEEX_Digits);
+
+ Write_Str (IEEEX_First'Universal_Literal_String);
+ Write_Str (" .. ");
+ Write_Str (IEEEX_Last'Universal_Literal_String);
+ end if;
+
+ Write_Str (";");
+ Write_Eol;
+ end P_Float_Range;
+
+ -----------------
+ -- P_Int_Range --
+ -----------------
+
+ procedure P_Int_Range (Size : Pos) is
+ begin
+ Write_Str (" is range -(2 **");
+ Write_Int (Size - 1);
+ Write_Str (")");
+ Write_Str (" .. +(2 **");
+ Write_Int (Size - 1);
+ Write_Str (" - 1);");
+ Write_Eol;
+ end P_Int_Range;
+
+ -- Start of processing for Print_Standard
+
+ begin
+ P ("-- Representation of package Standard");
+ Write_Eol;
+ P ("-- This is not accurate Ada, since new base types cannot be ");
+ P ("-- created, but the listing shows the target dependent");
+ P ("-- characteristics of the Standard types for this compiler");
+ Write_Eol;
+
+ P ("package Standard is");
+ P ("pragma Pure (Standard);");
+ Write_Eol;
+
+ P (" type Boolean is (False, True);");
+ P (" for Boolean'Size use 1;");
+ P (" for Boolean use (False => 0, True => 1);");
+ Write_Eol;
+
+ -- Integer types
+
+ Write_Str (" type Integer");
+ P_Int_Range (Standard_Integer_Size);
+ Write_Str (" for Integer'Size use ");
+ Write_Int (Standard_Integer_Size);
+ P (";");
+ Write_Eol;
+
+ P (" subtype Natural is Integer range 0 .. Integer'Last;");
+ P (" subtype Positive is Integer range 1 .. Integer'Last;");
+ Write_Eol;
+
+ Write_Str (" type Short_Short_Integer");
+ P_Int_Range (Standard_Short_Short_Integer_Size);
+ Write_Str (" for Short_Short_Integer'Size use ");
+ Write_Int (Standard_Short_Short_Integer_Size);
+ P (";");
+ Write_Eol;
+
+ Write_Str (" type Short_Integer");
+ P_Int_Range (Standard_Short_Integer_Size);
+ Write_Str (" for Short_Integer'Size use ");
+ Write_Int (Standard_Short_Integer_Size);
+ P (";");
+ Write_Eol;
+
+ Write_Str (" type Long_Integer");
+ P_Int_Range (Standard_Long_Integer_Size);
+ Write_Str (" for Long_Integer'Size use ");
+ Write_Int (Standard_Long_Integer_Size);
+ P (";");
+ Write_Eol;
+
+ Write_Str (" type Long_Long_Integer");
+ P_Int_Range (Standard_Long_Long_Integer_Size);
+ Write_Str (" for Long_Long_Integer'Size use ");
+ Write_Int (Standard_Long_Long_Integer_Size);
+ P (";");
+ Write_Eol;
+
+ -- Floating point types
+
+ Write_Str (" type Short_Float is digits ");
+ Write_Int (Standard_Short_Float_Digits);
+ Write_Eol;
+ P_Float_Range (Standard_Short_Float);
+ Write_Str (" for Short_Float'Size use ");
+ Write_Int (Standard_Short_Float_Size);
+ P (";");
+ Write_Eol;
+
+ Write_Str (" type Float is digits ");
+ Write_Int (Standard_Float_Digits);
+ Write_Eol;
+ P_Float_Range (Standard_Float);
+ Write_Str (" for Float'Size use ");
+ Write_Int (Standard_Float_Size);
+ P (";");
+ Write_Eol;
+
+ Write_Str (" type Long_Float is digits ");
+ Write_Int (Standard_Long_Float_Digits);
+ Write_Eol;
+ P_Float_Range (Standard_Long_Float);
+ Write_Str (" for Long_Float'Size use ");
+ Write_Int (Standard_Long_Float_Size);
+ P (";");
+ Write_Eol;
+
+ Write_Str (" type Long_Long_Float is digits ");
+ Write_Int (Standard_Long_Long_Float_Digits);
+ Write_Eol;
+ P_Float_Range (Standard_Long_Long_Float);
+ Write_Str (" for Long_Long_Float'Size use ");
+ Write_Int (Standard_Long_Long_Float_Size);
+ P (";");
+ Write_Eol;
+
+ P (" type Character is (...)");
+ Write_Str (" for Character'Size use ");
+ Write_Int (Standard_Character_Size);
+ P (";");
+ P (" -- See RM A.1(35) for details of this type");
+ Write_Eol;
+
+ P (" type Wide_Character is (...)");
+ Write_Str (" for Wide_Character'Size use ");
+ Write_Int (Standard_Wide_Character_Size);
+ P (";");
+ P (" -- See RM A.1(36) for details of this type");
+ Write_Eol;
+
+ P (" type Wide_Wide_Character is (...)");
+ 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");
+
+ P (" type String is array (Positive range <>) of Character;");
+ P (" pragma Pack (String);");
+ Write_Eol;
+
+ P (" type Wide_String is array (Positive range <>)" &
+ " of Wide_Character;");
+ P (" pragma Pack (Wide_String);");
+ Write_Eol;
+
+ P (" type Wide_Wide_String is array (Positive range <>)" &
+ " of Wide_Wide_Character;");
+ P (" pragma Pack (Wide_Wide_String);");
+ Write_Eol;
+
+ -- Here it's OK to use the Duration type of the host compiler since
+ -- the implementation of Duration in GNAT is target independent.
+
+ if Duration_32_Bits_On_Target then
+ P (" type Duration is delta 0.020");
+ P (" range -((2 ** 31 - 1) * 0.020) ..");
+ P (" +((2 ** 31 - 1) * 0.020);");
+ P (" for Duration'Small use 0.020;");
+ else
+ P (" type Duration is delta 0.000000001");
+ P (" range -((2 ** 63 - 1) * 0.000000001) ..");
+ P (" +((2 ** 63 - 1) * 0.000000001);");
+ P (" for Duration'Small use 0.000000001;");
+ end if;
+
+ Write_Eol;
+
+ P (" Constraint_Error : exception;");
+ P (" Program_Error : exception;");
+ P (" Storage_Error : exception;");
+ P (" Tasking_Error : exception;");
+ P (" Numeric_Error : exception renames Constraint_Error;");
+ Write_Eol;
+
+ P ("end Standard;");
+ end Print_Standard;
+
----------------------
-- Set_Float_Bounds --
----------------------
OSDN Git Service
