diff options
Diffstat (limited to 'gcc/ada/tbuild.adb')
| -rw-r--r-- | gcc/ada/tbuild.adb | 84 |
1 files changed, 82 insertions, 2 deletions
diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 3ccd7a7472e..b8ac33addc3 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -6,9 +6,9 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.98 $ +-- $Revision$ -- -- --- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2002, 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- -- @@ -108,6 +108,29 @@ package body Tbuild is end if; end Convert_To; + ------------------------------------------- + -- Make_Byte_Aligned_Attribute_Reference -- + ------------------------------------------- + + function Make_Byte_Aligned_Attribute_Reference + (Sloc : Source_Ptr; + Prefix : Node_Id; + Attribute_Name : Name_Id) + return Node_Id + is + N : constant Node_Id := + Make_Attribute_Reference (Sloc, + Prefix => Prefix, + Attribute_Name => Attribute_Name); + + begin + pragma Assert (Attribute_Name = Name_Address + or else + Attribute_Name = Name_Unrestricted_Access); + Set_Must_Be_Byte_Aligned (N, True); + return N; + end Make_Byte_Aligned_Attribute_Reference; + -------------------- -- Make_DT_Access -- -------------------- @@ -244,6 +267,63 @@ package body Tbuild is return Make_Integer_Literal (Loc, UI_From_Int (Intval)); end Make_Integer_Literal; + --------------------------------- + -- Make_Raise_Constraint_Error -- + --------------------------------- + + function Make_Raise_Constraint_Error + (Sloc : Source_Ptr; + Condition : Node_Id := Empty; + Reason : RT_Exception_Code) + return Node_Id + is + begin + pragma Assert (Reason in RT_CE_Exceptions); + return + Make_Raise_Constraint_Error (Sloc, + Condition => Condition, + Reason => + UI_From_Int (RT_Exception_Code'Pos (Reason))); + end Make_Raise_Constraint_Error; + + ------------------------------ + -- Make_Raise_Program_Error -- + ------------------------------ + + function Make_Raise_Program_Error + (Sloc : Source_Ptr; + Condition : Node_Id := Empty; + Reason : RT_Exception_Code) + return Node_Id + is + begin + pragma Assert (Reason in RT_PE_Exceptions); + return + Make_Raise_Program_Error (Sloc, + Condition => Condition, + Reason => + UI_From_Int (RT_Exception_Code'Pos (Reason))); + end Make_Raise_Program_Error; + + ------------------------------ + -- Make_Raise_Storage_Error -- + ------------------------------ + + function Make_Raise_Storage_Error + (Sloc : Source_Ptr; + Condition : Node_Id := Empty; + Reason : RT_Exception_Code) + return Node_Id + is + begin + pragma Assert (Reason in RT_SE_Exceptions); + return + Make_Raise_Storage_Error (Sloc, + Condition => Condition, + Reason => + UI_From_Int (RT_Exception_Code'Pos (Reason))); + end Make_Raise_Storage_Error; + --------------------------- -- Make_Unsuppress_Block -- --------------------------- |
