Skip to content

R
riscv-gcc-1
Commit 54838d1f by Arnaud Charlet
Options

snames.h, [...]: Add Attr_To_Any, Attr_From_Any and Attr_TypeCode defines. 

2008-08-04  Kevin Pouget  <pouget@adacore.com>

	* snames.h, snames.adb, snames.ads:
	Add Attr_To_Any, Attr_From_Any and Attr_TypeCode defines.

	* exp_dist.ads, exp_dist.adb: Add Build_From_Any_Call,
	Build_To_Any_Call and Build_TypeCode_Call procedures.

	* exp_attr.adb, sem_attr.adb: Add corresponding cases.

	* rtsfind.ads: Add corresponding names.

	* tbuild.adb: Update prefix restrictions to allow '_' character.

From-SVN: r138598
parent 9450205a
Showing with 266 additions and 55 deletions
gcc/ada/ChangeLog
2008-08-04 Jerome Lambourg <lambourg@adacore.com>
* g-comlin.adb (Group_Switches): Preserve the switch order when
grouping and allow switch grouping of switches with more than one
character extension (e.g. gnatw.x).
(Args_From_Expanded): Remove this now obsolete method.
2008-08-04 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Get_Allocator_Final_List): Freeze anonymous type for
chain at once, to ensure that type is properly decorated for back-end,
when allocator appears within a loop.
2008-08-04 Kevin Pouget <pouget@adacore.com>
* snames.h, snames.adb, snames.ads:
Add Attr_To_Any, Attr_From_Any and Attr_TypeCode defines.
* exp_dist.ads, exp_dist.adb: Add Build_From_Any_Call,
Build_To_Any_Call and Build_TypeCode_Call procedures.
* exp_attr.adb, sem_attr.adb: Add corresponding cases.
* rtsfind.ads: Add corresponding names.
* tbuild.adb: Update prefix restrictions to allow '_' character.
2008-08-04 Doug Rupp <rupp@adacore.com> 2008-08-04 Doug Rupp <rupp@adacore.com>
* gigi.h (fill_vms_descriptor): Add third parameter gnat_actual * gigi.h (fill_vms_descriptor): Add third parameter gnat_actual
gcc/ada/exp_attr.adb
...@@ -33,6 +33,7 @@ with Exp_Ch2; use Exp_Ch2; ...@@ -33,6 +33,7 @@ with Exp_Ch2; use Exp_Ch2;
with Exp_Ch3; use Exp_Ch3; with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6; with Exp_Ch6; use Exp_Ch6;
with Exp_Ch9; use Exp_Ch9; with Exp_Ch9; use Exp_Ch9;
with Exp_Dist; use Exp_Dist;
with Exp_Imgv; use Exp_Imgv; with Exp_Imgv; use Exp_Imgv;
with Exp_Pakd; use Exp_Pakd; with Exp_Pakd; use Exp_Pakd;
with Exp_Strm; use Exp_Strm; with Exp_Strm; use Exp_Strm;
...@@ -2075,6 +2076,22 @@ package body Exp_Attr is ...@@ -2075,6 +2076,22 @@ package body Exp_Attr is
Expand_Fpt_Attribute_R (N); Expand_Fpt_Attribute_R (N);
-------------- --------------
-- From_Any --
--------------
when Attribute_From_Any => From_Any : declare
P_Type : constant Entity_Id := Etype (Pref);
Decls : constant List_Id := New_List;
begin
Rewrite (N,
Build_From_Any_Call (P_Type,
Relocate_Node (First (Exprs)),
Decls));
Insert_Actions (N, Decls);
Analyze_And_Resolve (N, P_Type);
end From_Any;
--------------
-- Identity -- -- Identity --
-------------- --------------
...@@ -4396,6 +4413,22 @@ package body Exp_Attr is ...@@ -4396,6 +4413,22 @@ package body Exp_Attr is
Relocate_Node (First (Exprs)))); Relocate_Node (First (Exprs))));
Analyze_And_Resolve (N, RTE (RE_Address)); Analyze_And_Resolve (N, RTE (RE_Address));
------------
-- To_Any --
------------
when Attribute_To_Any => To_Any : declare
P_Type : constant Entity_Id := Etype (Pref);
Decls : constant List_Id := New_List;
begin
Rewrite (N,
Build_To_Any_Call
(Convert_To (P_Type,
Relocate_Node (First (Exprs))), Decls));
Insert_Actions (N, Decls);
Analyze_And_Resolve (N, RTE (RE_Any));
end To_Any;
---------------- ----------------
-- Truncation -- -- Truncation --
---------------- ----------------
...@@ -4409,6 +4442,19 @@ package body Exp_Attr is ...@@ -4409,6 +4442,19 @@ package body Exp_Attr is
Expand_Fpt_Attribute_R (N); Expand_Fpt_Attribute_R (N);
end if; end if;
--------------
-- TypeCode --
--------------
when Attribute_TypeCode => TypeCode : declare
P_Type : constant Entity_Id := Etype (Pref);
Decls : constant List_Id := New_List;
begin
Rewrite (N, Build_TypeCode_Call (Loc, P_Type, Decls));
Insert_Actions (N, Decls);
Analyze_And_Resolve (N, RTE (RE_TypeCode));
end TypeCode;
----------------------- -----------------------
-- Unbiased_Rounding -- -- Unbiased_Rounding --
----------------------- -----------------------
......
gcc/ada/exp_dist.adb
...@@ -858,6 +858,25 @@ package body Exp_Dist is ...@@ -858,6 +858,25 @@ package body Exp_Dist is
end PolyORB_Support; end PolyORB_Support;
-- The following PolyORB-specific subprograms are made visible to Exp_Attr:
function Build_From_Any_Call
(Typ : Entity_Id;
N : Node_Id;
Decls : List_Id) return Node_Id
renames PolyORB_Support.Helpers.Build_From_Any_Call;
function Build_To_Any_Call
(N : Node_Id;
Decls : List_Id) return Node_Id
renames PolyORB_Support.Helpers.Build_To_Any_Call;
function Build_TypeCode_Call
(Loc : Source_Ptr;
Typ : Entity_Id;
Decls : List_Id) return Node_Id
renames PolyORB_Support.Helpers.Build_TypeCode_Call;
------------------------------------ ------------------------------------
-- Local variables and structures -- -- Local variables and structures --
------------------------------------ ------------------------------------
...@@ -8218,12 +8237,11 @@ package body Exp_Dist is ...@@ -8218,12 +8237,11 @@ package body Exp_Dist is
-- point type from Standard, or the smallest unsigned (modular) type -- point type from Standard, or the smallest unsigned (modular) type
-- from System.Unsigned_Types, whose range encompasses that of Typ. -- from System.Unsigned_Types, whose range encompasses that of Typ.
function Make_Stream_Procedure_Function_Name function Make_Helper_Function_Name
(Loc : Source_Ptr; (Loc : Source_Ptr;
Typ : Entity_Id; Typ : Entity_Id;
Nam : Name_Id) return Entity_Id; Nam : Name_Id) return Entity_Id;
-- Return the name to be assigned for stream subprogram Nam of Typ. -- Return the name to be assigned for helper subprogram Nam of Typ
-- (copied from exp_strm.adb, should be shared???)
------------------------------------------------------------ ------------------------------------------------------------
-- Common subprograms for building various tree fragments -- -- Common subprograms for building various tree fragments --
...@@ -8432,6 +8450,11 @@ package body Exp_Dist is ...@@ -8432,6 +8450,11 @@ package body Exp_Dist is
elsif U_Type = Standard_String then elsif U_Type = Standard_String then
Lib_RE := RE_FA_String; Lib_RE := RE_FA_String;
-- Special DSA types
elsif Is_RTE (U_Type, RE_Any_Content_Ptr) then
Lib_RE := RE_FA_A;
-- Other (non-primitive) types -- Other (non-primitive) types
else else
...@@ -8493,8 +8516,7 @@ package body Exp_Dist is ...@@ -8493,8 +8516,7 @@ package body Exp_Dist is
return; return;
end if; end if;
Fnam := Fnam := Make_Helper_Function_Name (Loc, Typ, Name_From_Any);
Make_Stream_Procedure_Function_Name (Loc, Typ, Name_uFrom_Any);
Spec := Spec :=
Make_Function_Specification (Loc, Make_Function_Specification (Loc,
...@@ -9293,7 +9315,13 @@ package body Exp_Dist is ...@@ -9293,7 +9315,13 @@ package body Exp_Dist is
elsif U_Type = Standard_String then elsif U_Type = Standard_String then
Lib_RE := RE_TA_String; Lib_RE := RE_TA_String;
-- Special DSA types
elsif Is_RTE (U_Type, RE_Any_Content_Ptr) then
Lib_RE := RE_TA_A;
elsif U_Type = Underlying_Type (RTE (RE_TypeCode)) then elsif U_Type = Underlying_Type (RTE (RE_TypeCode)) then
-- No corresponding FA_TC ???
Lib_RE := RE_TA_TC; Lib_RE := RE_TA_TC;
-- Other (non-primitive) types -- Other (non-primitive) types
...@@ -9358,8 +9386,7 @@ package body Exp_Dist is ...@@ -9358,8 +9386,7 @@ package body Exp_Dist is
return; return;
end if; end if;
Fnam := Fnam := Make_Helper_Function_Name (Loc, Typ, Name_To_Any);
Make_Stream_Procedure_Function_Name (Loc, Typ, Name_uTo_Any);
Spec := Spec :=
Make_Function_Specification (Loc, Make_Function_Specification (Loc,
...@@ -9976,7 +10003,7 @@ package body Exp_Dist is ...@@ -9976,7 +10003,7 @@ package body Exp_Dist is
-- not been set yet, so can't call Find_Inherited_TSS. -- not been set yet, so can't call Find_Inherited_TSS.
if Typ = RTE (RE_Any) then if Typ = RTE (RE_Any) then
Fnam := RTE (RE_TC_Any); Fnam := RTE (RE_TC_A);
else else
-- First simple case where the TypeCode is present -- First simple case where the TypeCode is present
...@@ -10057,6 +10084,11 @@ package body Exp_Dist is ...@@ -10057,6 +10084,11 @@ package body Exp_Dist is
elsif U_Type = Standard_String then elsif U_Type = Standard_String then
Lib_RE := RE_TC_String; Lib_RE := RE_TC_String;
-- Special DSA types
elsif Is_RTE (U_Type, RE_Any_Content_Ptr) then
Lib_RE := RE_TC_A;
-- Other (non-primitive) types -- Other (non-primitive) types
else else
...@@ -10100,8 +10132,7 @@ package body Exp_Dist is ...@@ -10100,8 +10132,7 @@ package body Exp_Dist is
Stms : constant List_Id := New_List; Stms : constant List_Id := New_List;
TCNam : constant Entity_Id := TCNam : constant Entity_Id :=
Make_Stream_Procedure_Function_Name (Loc, Make_Helper_Function_Name (Loc, Typ, Name_TypeCode);
Typ, Name_uTypeCode);
Parameters : List_Id; Parameters : List_Id;
...@@ -10964,30 +10995,40 @@ package body Exp_Dist is ...@@ -10964,30 +10995,40 @@ package body Exp_Dist is
end; end;
end Append_Array_Traversal; end Append_Array_Traversal;
----------------------------------------- -------------------------------
-- Make_Stream_Procedure_Function_Name -- -- Make_Helper_Function_Name --
----------------------------------------- -------------------------------
function Make_Stream_Procedure_Function_Name function Make_Helper_Function_Name
(Loc : Source_Ptr; (Loc : Source_Ptr;
Typ : Entity_Id; Typ : Entity_Id;
Nam : Name_Id) return Entity_Id Nam : Name_Id) return Entity_Id
is is
begin begin
-- For tagged types, we use a canonical name so that it matches
-- the primitive spec. For all other cases, we use a serialized
-- name so that multiple generations of the same procedure do not
-- clash.
if Is_Tagged_Type (Typ) then declare
return Make_Defining_Identifier (Loc, Nam); Serial : Nat := 0;
else -- For tagged types, we use a canonical name so that it matches
-- the primitive spec. For all other cases, we use a serialized
-- name so that multiple generations of the same procedure do
-- not clash.
begin
if not Is_Tagged_Type (Typ) then
Serial := Increment_Serial_Number;
end if;
-- Use prefixed underscore to avoid potential clash with used
-- identifier (we use attribute names for Nam).
return return
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Chars =>
New_External_Name (Nam, ' ', Increment_Serial_Number)); New_External_Name
end if; (Related_Id => Nam,
end Make_Stream_Procedure_Function_Name; Suffix => ' ', Suffix_Index => Serial,
Prefix => '_'));
end;
end Make_Helper_Function_Name;
end Helpers; end Helpers;
----------------------------------- -----------------------------------
......
gcc/ada/exp_dist.ads
...@@ -129,4 +129,37 @@ package Exp_Dist is ...@@ -129,4 +129,37 @@ package Exp_Dist is
-- a remote call) satisfies the requirements for being transportable -- a remote call) satisfies the requirements for being transportable
-- across partitions, raising Program_Error if it does not. -- across partitions, raising Program_Error if it does not.
----------------------------------------------------------------
-- Functions for expansion of PolyORB/DSA specific attributes --
----------------------------------------------------------------
function Build_From_Any_Call
(Typ : Entity_Id;
N : Node_Id;
Decls : List_Id) return Node_Id;
-- Build call to From_Any attribute function of type Typ with expression
-- N as actual parameter. Decls is the declarations list for an appropriate
-- enclosing scope of the point where the call will be inserted; if the
-- From_Any attribute for Typ needs to be generated at this point, its
-- declaration is appended to Decls.
function Build_To_Any_Call
(N : Node_Id;
Decls : List_Id) return Node_Id;
-- Build call to To_Any attribute function with expression as actual
-- parameter. Decls is the declarations list for an appropriate
-- enclosing scope of the point where the call will be inserted; if
-- the To_Any attribute for Typ needs to be generated at this point,
-- its declaration is appended to Decls.
function Build_TypeCode_Call
(Loc : Source_Ptr;
Typ : Entity_Id;
Decls : List_Id) return Node_Id;
-- Build call to TypeCode attribute function for Typ. Decls is the
-- declarations list for an appropriate enclosing scope of the point
-- where the call will be inserted; if the To_Any attribute for Typ
-- needs to be generated at this point, its declaration is appended
-- to Decls.
end Exp_Dist; end Exp_Dist;
gcc/ada/rtsfind.ads
...@@ -209,6 +209,7 @@ package Rtsfind is ...@@ -209,6 +209,7 @@ package Rtsfind is
System_Compare_Array_Unsigned_64, System_Compare_Array_Unsigned_64,
System_Compare_Array_Unsigned_8, System_Compare_Array_Unsigned_8,
System_DSA_Services, System_DSA_Services,
System_DSA_Types,
System_Exception_Table, System_Exception_Table,
System_Exceptions, System_Exceptions,
System_Exn_Int, System_Exn_Int,
...@@ -696,6 +697,8 @@ package Rtsfind is ...@@ -696,6 +697,8 @@ package Rtsfind is
RE_Get_Local_Partition_Id, -- System.DSA_Services RE_Get_Local_Partition_Id, -- System.DSA_Services
RE_Get_Passive_Partition_Id, -- System.DSA_Services RE_Get_Passive_Partition_Id, -- System.DSA_Services
RE_Any_Content_Ptr, -- System.DSA_Types
RE_Register_Exception, -- System.Exception_Table RE_Register_Exception, -- System.Exception_Table
RE_Local_Raise, -- System.Exceptions RE_Local_Raise, -- System.Exceptions
...@@ -1157,6 +1160,7 @@ package Rtsfind is ...@@ -1157,6 +1160,7 @@ package Rtsfind is
RE_BS_To_Any, -- System.Partition_Interface RE_BS_To_Any, -- System.Partition_Interface
RE_Any_To_BS, -- System.Partition_Interface RE_Any_To_BS, -- System.Partition_Interface
RE_FA_A, -- System.Partition_Interface
RE_FA_B, -- System.Partition_Interface RE_FA_B, -- System.Partition_Interface
RE_FA_C, -- System.Partition_Interface RE_FA_C, -- System.Partition_Interface
RE_FA_F, -- System.Partition_Interface RE_FA_F, -- System.Partition_Interface
...@@ -1205,7 +1209,7 @@ package Rtsfind is ...@@ -1205,7 +1209,7 @@ package Rtsfind is
RE_TC_Build, -- System.Partition_Interface RE_TC_Build, -- System.Partition_Interface
RE_Get_TC, -- System.Partition_Interface RE_Get_TC, -- System.Partition_Interface
RE_Set_TC, -- System.Partition_Interface RE_Set_TC, -- System.Partition_Interface
RE_TC_Any, -- System.Partition_Interface RE_TC_A, -- System.Partition_Interface
RE_TC_B, -- System.Partition_Interface RE_TC_B, -- System.Partition_Interface
RE_TC_C, -- System.Partition_Interface RE_TC_C, -- System.Partition_Interface
RE_TC_F, -- System.Partition_Interface RE_TC_F, -- System.Partition_Interface
...@@ -1850,6 +1854,8 @@ package Rtsfind is ...@@ -1850,6 +1854,8 @@ package Rtsfind is
RE_Get_Local_Partition_Id => System_DSA_Services, RE_Get_Local_Partition_Id => System_DSA_Services,
RE_Get_Passive_Partition_Id => System_DSA_Services, RE_Get_Passive_Partition_Id => System_DSA_Services,
RE_Any_Content_Ptr => System_DSA_Types,
RE_Register_Exception => System_Exception_Table, RE_Register_Exception => System_Exception_Table,
RE_Local_Raise => System_Exceptions, RE_Local_Raise => System_Exceptions,
...@@ -2302,6 +2308,7 @@ package Rtsfind is ...@@ -2302,6 +2308,7 @@ package Rtsfind is
RE_BS_To_Any => System_Partition_Interface, RE_BS_To_Any => System_Partition_Interface,
RE_Any_To_BS => System_Partition_Interface, RE_Any_To_BS => System_Partition_Interface,
RE_FA_A => System_Partition_Interface,
RE_FA_B => System_Partition_Interface, RE_FA_B => System_Partition_Interface,
RE_FA_C => System_Partition_Interface, RE_FA_C => System_Partition_Interface,
RE_FA_F => System_Partition_Interface, RE_FA_F => System_Partition_Interface,
...@@ -2350,7 +2357,7 @@ package Rtsfind is ...@@ -2350,7 +2357,7 @@ package Rtsfind is
RE_TC_Build => System_Partition_Interface, RE_TC_Build => System_Partition_Interface,
RE_Get_TC => System_Partition_Interface, RE_Get_TC => System_Partition_Interface,
RE_Set_TC => System_Partition_Interface, RE_Set_TC => System_Partition_Interface,
RE_TC_Any => System_Partition_Interface, RE_TC_A => System_Partition_Interface,
RE_TC_B => System_Partition_Interface, RE_TC_B => System_Partition_Interface,
RE_TC_C => System_Partition_Interface, RE_TC_C => System_Partition_Interface,
RE_TC_F => System_Partition_Interface, RE_TC_F => System_Partition_Interface,
......
gcc/ada/sem_attr.adb
...@@ -315,6 +315,9 @@ package body Sem_Attr is ...@@ -315,6 +315,9 @@ package body Sem_Attr is
-- corresponding possible defined attribute function (e.g. for the -- corresponding possible defined attribute function (e.g. for the
-- Read attribute, Nam will be TSS_Stream_Read). -- Read attribute, Nam will be TSS_Stream_Read).
procedure Check_PolyORB_Attribute;
-- Validity checking for PolyORB/DSA attribute
procedure Check_Task_Prefix; procedure Check_Task_Prefix;
-- Verify that prefix of attribute N is a task or task type -- Verify that prefix of attribute N is a task or task type
...@@ -1380,6 +1383,23 @@ package body Sem_Attr is ...@@ -1380,6 +1383,23 @@ package body Sem_Attr is
end if; end if;
end Check_Object_Reference; end Check_Object_Reference;
----------------------------
-- Check_PolyORB_Attribute --
----------------------------
procedure Check_PolyORB_Attribute is
begin
Validate_Non_Static_Attribute_Function_Call;
Check_Type;
Check_Not_CPP_Type;
if Get_PCS_Name /= Name_PolyORB_DSA then
Error_Attr
("attribute% requires the 'Poly'O'R'B 'P'C'S", N);
end if;
end Check_PolyORB_Attribute;
------------------------ ------------------------
-- Check_Program_Unit -- -- Check_Program_Unit --
------------------------ ------------------------
...@@ -2976,6 +2996,15 @@ package body Sem_Attr is ...@@ -2976,6 +2996,15 @@ package body Sem_Attr is
Set_Etype (N, P_Base_Type); Set_Etype (N, P_Base_Type);
Resolve (E1, P_Base_Type); Resolve (E1, P_Base_Type);
--------------
-- From_Any --
--------------
when Attribute_From_Any =>
Check_E1;
Check_PolyORB_Attribute;
Set_Etype (N, P_Base_Type);
----------------------- -----------------------
-- Has_Access_Values -- -- Has_Access_Values --
----------------------- -----------------------
...@@ -4238,6 +4267,15 @@ package body Sem_Attr is ...@@ -4238,6 +4267,15 @@ package body Sem_Attr is
Analyze_And_Resolve (E1, Any_Integer); Analyze_And_Resolve (E1, Any_Integer);
Set_Etype (N, RTE (RE_Address)); Set_Etype (N, RTE (RE_Address));
------------
-- To_Any --
------------
when Attribute_To_Any =>
Check_E1;
Check_PolyORB_Attribute;
Set_Etype (N, RTE (RE_Any));
---------------- ----------------
-- Truncation -- -- Truncation --
---------------- ----------------
...@@ -4257,6 +4295,15 @@ package body Sem_Attr is ...@@ -4257,6 +4295,15 @@ package body Sem_Attr is
Check_Not_Incomplete_Type; Check_Not_Incomplete_Type;
Set_Etype (N, RTE (RE_Type_Class)); Set_Etype (N, RTE (RE_Type_Class));
------------
-- To_Any --
------------
when Attribute_TypeCode =>
Check_E0;
Check_PolyORB_Attribute;
Set_Etype (N, RTE (RE_TypeCode));
----------------- -----------------
-- UET_Address -- -- UET_Address --
----------------- -----------------
...@@ -7253,6 +7300,13 @@ package body Sem_Attr is ...@@ -7253,6 +7300,13 @@ package body Sem_Attr is
end if; end if;
end Width; end Width;
-- The following attributes denote function that cannot be folded
when Attribute_From_Any |
Attribute_To_Any |
Attribute_TypeCode =>
null;
-- The following attributes can never be folded, and furthermore we -- The following attributes can never be folded, and furthermore we
-- should not even have entered the case statement for any of these. -- should not even have entered the case statement for any of these.
-- Note that in some cases, the values have already been folded as -- Note that in some cases, the values have already been folded as
......
gcc/ada/snames.adb
...@@ -104,9 +104,6 @@ package body Snames is ...@@ -104,9 +104,6 @@ package body Snames is
"finalize#" & "finalize#" &
"next#" & "next#" &
"prev#" & "prev#" &
"_typecode#" &
"_from_any#" &
"_to_any#" &
"allocate#" & "allocate#" &
"deallocate#" & "deallocate#" &
"dereference#" & "dereference#" &
...@@ -557,6 +554,7 @@ package body Snames is ...@@ -557,6 +554,7 @@ package body Snames is
"copy_sign#" & "copy_sign#" &
"floor#" & "floor#" &
"fraction#" & "fraction#" &
"from_any#" &
"image#" & "image#" &
"input#" & "input#" &
"machine#" & "machine#" &
...@@ -567,7 +565,9 @@ package body Snames is ...@@ -567,7 +565,9 @@ package body Snames is
"remainder#" & "remainder#" &
"rounding#" & "rounding#" &
"succ#" & "succ#" &
"to_any#" &
"truncation#" & "truncation#" &
"typecode#" &
"value#" & "value#" &
"wide_image#" & "wide_image#" &
"wide_wide_image#" & "wide_wide_image#" &
......
gcc/ada/snames.h
...@@ -164,31 +164,34 @@ extern unsigned char Get_Attribute_Id (int); ...@@ -164,31 +164,34 @@ extern unsigned char Get_Attribute_Id (int);
#define Attr_Copy_Sign 117 #define Attr_Copy_Sign 117
#define Attr_Floor 118 #define Attr_Floor 118
#define Attr_Fraction 119 #define Attr_Fraction 119
#define Attr_Image 120 #define Attr_From_Any 120
#define Attr_Input 121 #define Attr_Image 121
#define Attr_Machine 122 #define Attr_Input 122
#define Attr_Max 123 #define Attr_Machine 123
#define Attr_Min 124 #define Attr_Max 124
#define Attr_Model 125 #define Attr_Min 125
#define Attr_Pred 126 #define Attr_Model 126
#define Attr_Remainder 127 #define Attr_Pred 127
#define Attr_Rounding 128 #define Attr_Remainder 128
#define Attr_Succ 129 #define Attr_Rounding 129
#define Attr_Truncation 130 #define Attr_Succ 130
#define Attr_Value 131 #define Attr_To_Any 131
#define Attr_Wide_Image 132 #define Attr_Truncation 132
#define Attr_Wide_Wide_Image 133 #define Attr_TypeCode 133
#define Attr_Wide_Value 134 #define Attr_Value 134
#define Attr_Wide_Wide_Value 135 #define Attr_Wide_Image 135
#define Attr_Output 136 #define Attr_Wide_Wide_Image 136
#define Attr_Read 137 #define Attr_Wide_Value 137
#define Attr_Write 138 #define Attr_Wide_Wide_Value 138
#define Attr_Elab_Body 139 #define Attr_Output 139
#define Attr_Elab_Spec 140 #define Attr_Read 140
#define Attr_Storage_Pool 141 #define Attr_Write 141
#define Attr_Base 142 #define Attr_Elab_Body 142
#define Attr_Class 143 #define Attr_Elab_Spec 143
#define Attr_Stub_Type 144 #define Attr_Storage_Pool 144
#define Attr_Base 145
#define Attr_Class 146
#define Attr_Stub_Type 147
/* Define the numeric values for the conventions. */ /* Define the numeric values for the conventions. */
......
gcc/ada/tbuild.adb
...@@ -498,7 +498,7 @@ package body Tbuild is ...@@ -498,7 +498,7 @@ package body Tbuild is
Get_Name_String (Related_Id); Get_Name_String (Related_Id);
if Prefix /= ' ' then if Prefix /= ' ' then
pragma Assert (Is_OK_Internal_Letter (Prefix)); pragma Assert (Is_OK_Internal_Letter (Prefix) or else Prefix = '_');
for J in reverse 1 .. Name_Len loop for J in reverse 1 .. Name_Len loop
Name_Buffer (J + 1) := Name_Buffer (J); Name_Buffer (J + 1) := Name_Buffer (J);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment