diff options
Diffstat (limited to 'gcc/ada/cstand.adb')
| -rw-r--r-- | gcc/ada/cstand.adb | 174 |
1 files changed, 140 insertions, 34 deletions
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 73afd401c2f..1f45f5e6d63 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -195,13 +195,14 @@ package body CStand is Binary_Ops : constant array (S_Binary_Ops) of Name_Id := -- There is one entry here for each binary operator, except for the - -- case of concatenation, where there are two entries, one for a - -- String result, and one for a Wide_String result. + -- 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, @@ -222,24 +223,25 @@ package body CStand is -- 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) - 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 + (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 := @@ -277,13 +279,20 @@ package body CStand is -- 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; --------------------- @@ -537,8 +546,8 @@ package body CStand is 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); @@ -547,8 +556,8 @@ package body CStand is 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); @@ -582,8 +591,8 @@ package body CStand is 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); @@ -592,8 +601,8 @@ package body CStand is 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); @@ -601,6 +610,54 @@ package body CStand is 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 (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); @@ -609,9 +666,9 @@ package body CStand is 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_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; @@ -637,6 +694,7 @@ package body CStand is -- Create type definition node for type Wide_String Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc); + declare CompDef_Node : Node_Id; begin @@ -647,6 +705,7 @@ package body CStand is 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); @@ -665,6 +724,42 @@ package body CStand is Set_Entity (E_Id, Standard_Positive); Set_Etype (E_Id, Standard_Positive); + -- Create type definition node for type Wide_Wide_String + + 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 (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); + -- Create subtype declaration for Natural Decl := New_Node (N_Subtype_Declaration, Stloc); @@ -760,7 +855,7 @@ package body CStand is 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); @@ -1703,6 +1798,12 @@ package body CStand is P (" -- See RM A.1(36) for details of this type"); Write_Eol; + P (" type Wide_Wide_Character is (...)"); + Write_Str (" for 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; @@ -1712,6 +1813,11 @@ package body CStand is 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. |