From 0c644c99db0e5a83b8106a25e8346c2ecc250297 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 15 May 2012 10:17:26 +0000 Subject: [PATCH] fe.h (Get_RT_Exception_Name): Define. 2012-05-15 Tristan Gingold * fe.h (Get_RT_Exception_Name): Define. * types.ads (RT_Exception_Code): Update comment. * exp_ch11.adb, exp_ch11.ads (Get_RT_Exception_Name): New procedure to get the name of the rcheck subprograms. * a-except-2005.adb (Rcheck_xx): Rename. * a-except.adb Likewise, but also keep the old Rcheck_nn routines for bootstrap. * arith64.c (__gnat_mulv64): Use __gnat_rcheck_CE_Overflow_Check instead of __gnat_rcheck_10. * gcc-interface/trans.c (build_raise_check): Use Get_RT_Exception_Name to create the __gnat_rcheck routines name. * gcc-interface/Make-lang.in: Update dependencies. From-SVN: r187517 --- gcc/ada/ChangeLog | 15 + gcc/ada/a-except-2005.adb | 555 ++++++++++++++++++----------- gcc/ada/a-except.adb | 508 +++++++++++++++++++++----- gcc/ada/arit64.c | 6 +- gcc/ada/exp_ch11.adb | 82 +++++ gcc/ada/exp_ch11.ads | 8 +- gcc/ada/fe.h | 3 +- gcc/ada/gcc-interface/Make-lang.in | 157 ++++---- gcc/ada/gcc-interface/trans.c | 15 +- gcc/ada/types.ads | 6 +- 10 files changed, 967 insertions(+), 388 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cf335cac045..4987e599cc5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2012-05-15 Tristan Gingold + + * fe.h (Get_RT_Exception_Name): Define. + * types.ads (RT_Exception_Code): Update comment. + * exp_ch11.adb, exp_ch11.ads (Get_RT_Exception_Name): New + procedure to get the name of the rcheck subprograms. + * a-except-2005.adb (Rcheck_xx): Rename. + * a-except.adb Likewise, but also keep the old Rcheck_nn routines + for bootstrap. + * arith64.c (__gnat_mulv64): Use __gnat_rcheck_CE_Overflow_Check + instead of __gnat_rcheck_10. + * gcc-interface/trans.c (build_raise_check): Use Get_RT_Exception_Name + to create the __gnat_rcheck routines name. + * gcc-interface/Make-lang.in: Update dependencies. + 2012-05-15 Tristan Gingold * exp_ch7.adb (Build_Exception_Handler): Save current diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 179a0bdddda..a42c82efa09 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -396,146 +396,217 @@ package body Ada.Exceptions is -- These routines raise a specific exception with a reason message -- attached. The parameters are the file name and line number in each - -- case. The names are keyed to the codes defined in types.ads and - -- a-types.h (for example, the name Rcheck_05 refers to the Reason - -- RT_Exception_Code'Val (5)). - - procedure Rcheck_00 (File : System.Address; Line : Integer); - procedure Rcheck_01 (File : System.Address; Line : Integer); - procedure Rcheck_02 (File : System.Address; Line : Integer); - procedure Rcheck_03 (File : System.Address; Line : Integer); - procedure Rcheck_04 (File : System.Address; Line : Integer); - procedure Rcheck_05 (File : System.Address; Line : Integer); - procedure Rcheck_06 (File : System.Address; Line : Integer); - procedure Rcheck_07 (File : System.Address; Line : Integer); - procedure Rcheck_08 (File : System.Address; Line : Integer); - procedure Rcheck_09 (File : System.Address; Line : Integer); - procedure Rcheck_10 (File : System.Address; Line : Integer); - procedure Rcheck_11 (File : System.Address; Line : Integer); - procedure Rcheck_12 (File : System.Address; Line : Integer); - procedure Rcheck_13 (File : System.Address; Line : Integer); - procedure Rcheck_14 (File : System.Address; Line : Integer); - procedure Rcheck_15 (File : System.Address; Line : Integer); - procedure Rcheck_16 (File : System.Address; Line : Integer); - procedure Rcheck_17 (File : System.Address; Line : Integer); - procedure Rcheck_18 (File : System.Address; Line : Integer); - procedure Rcheck_19 (File : System.Address; Line : Integer); - procedure Rcheck_20 (File : System.Address; Line : Integer); - procedure Rcheck_21 (File : System.Address; Line : Integer); - procedure Rcheck_23 (File : System.Address; Line : Integer); - procedure Rcheck_24 (File : System.Address; Line : Integer); - procedure Rcheck_25 (File : System.Address; Line : Integer); - procedure Rcheck_26 (File : System.Address; Line : Integer); - procedure Rcheck_27 (File : System.Address; Line : Integer); - procedure Rcheck_28 (File : System.Address; Line : Integer); - procedure Rcheck_29 (File : System.Address; Line : Integer); - procedure Rcheck_30 (File : System.Address; Line : Integer); - procedure Rcheck_31 (File : System.Address; Line : Integer); - procedure Rcheck_32 (File : System.Address; Line : Integer); - procedure Rcheck_33 (File : System.Address; Line : Integer); - procedure Rcheck_34 (File : System.Address; Line : Integer); - - procedure Rcheck_00_Ext + -- case. The names are defined by Exp_Ch11.Get_RT_Exception_Name. + + procedure Rcheck_CE_Access_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Null_Access_Parameter + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Discriminant_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Divide_By_Zero + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Explicit_Raise + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Index_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Invalid_Data + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Length_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Null_Exception_Id + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Null_Not_Allowed + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Overflow_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Partition_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Range_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Tag_Check + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Access_Before_Elaboration + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Accessibility_Check + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Address_Of_Intrinsic + (File : System.Address; Line : Integer); + procedure Rcheck_PE_All_Guards_Closed + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Bad_Predicated_Generic_Type + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Current_Task_In_Entry_Body + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Duplicated_Entry_Address + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Explicit_Raise + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Implicit_Return + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Misaligned_Address_Value + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Missing_Return + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Overlaid_Controlled_Object + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Potentially_Blocking_Operation + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Stubbed_Subprogram_Called + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Unchecked_Union_Restriction + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Empty_Storage_Pool + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Explicit_Raise + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Infinite_Recursion + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Object_Too_Large + (File : System.Address; Line : Integer); + + procedure Rcheck_CE_Access_Check_Ext (File : System.Address; Line, Column : Integer); - procedure Rcheck_05_Ext + procedure Rcheck_CE_Index_Check_Ext (File : System.Address; Line, Column, Index, First, Last : Integer); - procedure Rcheck_06_Ext + procedure Rcheck_CE_Invalid_Data_Ext (File : System.Address; Line, Column, Index, First, Last : Integer); - procedure Rcheck_12_Ext + procedure Rcheck_CE_Range_Check_Ext (File : System.Address; Line, Column, Index, First, Last : Integer); - procedure Rcheck_22 (File : System.Address; Line : Integer); + procedure Rcheck_PE_Finalize_Raised_Exception + (File : System.Address; Line : Integer); -- This routine is separated out because it has quite different behavior -- from the others. This is the "finalize/adjust raised exception". This -- subprogram is always called with abort deferred, unlike all other -- Rcheck_* routines, it needs to call Raise_Exception_No_Defer. - -- - -- It should probably have a distinguished name ??? - - pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); - pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); - pragma Export (C, Rcheck_02, "__gnat_rcheck_02"); - pragma Export (C, Rcheck_03, "__gnat_rcheck_03"); - pragma Export (C, Rcheck_04, "__gnat_rcheck_04"); - pragma Export (C, Rcheck_05, "__gnat_rcheck_05"); - pragma Export (C, Rcheck_06, "__gnat_rcheck_06"); - pragma Export (C, Rcheck_07, "__gnat_rcheck_07"); - pragma Export (C, Rcheck_08, "__gnat_rcheck_08"); - pragma Export (C, Rcheck_09, "__gnat_rcheck_09"); - pragma Export (C, Rcheck_10, "__gnat_rcheck_10"); - pragma Export (C, Rcheck_11, "__gnat_rcheck_11"); - pragma Export (C, Rcheck_12, "__gnat_rcheck_12"); - pragma Export (C, Rcheck_13, "__gnat_rcheck_13"); - pragma Export (C, Rcheck_14, "__gnat_rcheck_14"); - pragma Export (C, Rcheck_15, "__gnat_rcheck_15"); - pragma Export (C, Rcheck_16, "__gnat_rcheck_16"); - pragma Export (C, Rcheck_17, "__gnat_rcheck_17"); - pragma Export (C, Rcheck_18, "__gnat_rcheck_18"); - pragma Export (C, Rcheck_19, "__gnat_rcheck_19"); - pragma Export (C, Rcheck_20, "__gnat_rcheck_20"); - pragma Export (C, Rcheck_21, "__gnat_rcheck_21"); - pragma Export (C, Rcheck_22, "__gnat_rcheck_22"); - pragma Export (C, Rcheck_23, "__gnat_rcheck_23"); - pragma Export (C, Rcheck_24, "__gnat_rcheck_24"); - pragma Export (C, Rcheck_25, "__gnat_rcheck_25"); - pragma Export (C, Rcheck_26, "__gnat_rcheck_26"); - pragma Export (C, Rcheck_27, "__gnat_rcheck_27"); - pragma Export (C, Rcheck_28, "__gnat_rcheck_28"); - pragma Export (C, Rcheck_29, "__gnat_rcheck_29"); - pragma Export (C, Rcheck_30, "__gnat_rcheck_30"); - pragma Export (C, Rcheck_31, "__gnat_rcheck_31"); - pragma Export (C, Rcheck_32, "__gnat_rcheck_32"); - pragma Export (C, Rcheck_33, "__gnat_rcheck_33"); - pragma Export (C, Rcheck_34, "__gnat_rcheck_34"); - - pragma Export (C, Rcheck_00_Ext, "__gnat_rcheck_00_ext"); - pragma Export (C, Rcheck_05_Ext, "__gnat_rcheck_05_ext"); - pragma Export (C, Rcheck_06_Ext, "__gnat_rcheck_06_ext"); - pragma Export (C, Rcheck_12_Ext, "__gnat_rcheck_12_ext"); + + pragma Export (C, Rcheck_CE_Access_Check, + "__gnat_rcheck_CE_Access_Check"); + pragma Export (C, Rcheck_CE_Null_Access_Parameter, + "__gnat_rcheck_CE_Null_Access_Parameter"); + pragma Export (C, Rcheck_CE_Discriminant_Check, + "__gnat_rcheck_CE_Discriminant_Check"); + pragma Export (C, Rcheck_CE_Divide_By_Zero, + "__gnat_rcheck_CE_Divide_By_Zero"); + pragma Export (C, Rcheck_CE_Explicit_Raise, + "__gnat_rcheck_CE_Explicit_Raise"); + pragma Export (C, Rcheck_CE_Index_Check, + "__gnat_rcheck_CE_Index_Check"); + pragma Export (C, Rcheck_CE_Invalid_Data, + "__gnat_rcheck_CE_Invalid_Data"); + pragma Export (C, Rcheck_CE_Length_Check, + "__gnat_rcheck_CE_Length_Check"); + pragma Export (C, Rcheck_CE_Null_Exception_Id, + "__gnat_rcheck_CE_Null_Exception_Id"); + pragma Export (C, Rcheck_CE_Null_Not_Allowed, + "__gnat_rcheck_CE_Null_Not_Allowed"); + pragma Export (C, Rcheck_CE_Overflow_Check, + "__gnat_rcheck_CE_Overflow_Check"); + pragma Export (C, Rcheck_CE_Partition_Check, + "__gnat_rcheck_CE_Partition_Check"); + pragma Export (C, Rcheck_CE_Range_Check, + "__gnat_rcheck_CE_Range_Check"); + pragma Export (C, Rcheck_CE_Tag_Check, + "__gnat_rcheck_CE_Tag_Check"); + pragma Export (C, Rcheck_PE_Access_Before_Elaboration, + "__gnat_rcheck_PE_Access_Before_Elaboration"); + pragma Export (C, Rcheck_PE_Accessibility_Check, + "__gnat_rcheck_PE_Accessibility_Check"); + pragma Export (C, Rcheck_PE_Address_Of_Intrinsic, + "__gnat_rcheck_PE_Address_Of_Intrinsic"); + pragma Export (C, Rcheck_PE_All_Guards_Closed, + "__gnat_rcheck_PE_All_Guards_Closed"); + pragma Export (C, Rcheck_PE_Bad_Predicated_Generic_Type, + "__gnat_rcheck_PE_Bad_Predicated_Generic_Type"); + pragma Export (C, Rcheck_PE_Current_Task_In_Entry_Body, + "__gnat_rcheck_PE_Current_Task_In_Entry_Body"); + pragma Export (C, Rcheck_PE_Duplicated_Entry_Address, + "__gnat_rcheck_PE_Duplicated_Entry_Address"); + pragma Export (C, Rcheck_PE_Explicit_Raise, + "__gnat_rcheck_PE_Explicit_Raise"); + pragma Export (C, Rcheck_PE_Finalize_Raised_Exception, + "__gnat_rcheck_PE_Finalize_Raised_Exception"); + pragma Export (C, Rcheck_PE_Implicit_Return, + "__gnat_rcheck_PE_Implicit_Return"); + pragma Export (C, Rcheck_PE_Misaligned_Address_Value, + "__gnat_rcheck_PE_Misaligned_Address_Value"); + pragma Export (C, Rcheck_PE_Missing_Return, + "__gnat_rcheck_PE_Missing_Return"); + pragma Export (C, Rcheck_PE_Overlaid_Controlled_Object, + "__gnat_rcheck_PE_Overlaid_Controlled_Object"); + pragma Export (C, Rcheck_PE_Potentially_Blocking_Operation, + "__gnat_rcheck_PE_Potentially_Blocking_Operation"); + pragma Export (C, Rcheck_PE_Stubbed_Subprogram_Called, + "__gnat_rcheck_PE_Stubbed_Subprogram_Called"); + pragma Export (C, Rcheck_PE_Unchecked_Union_Restriction, + "__gnat_rcheck_PE_Unchecked_Union_Restriction"); + pragma Export (C, Rcheck_PE_Non_Transportable_Actual, + "__gnat_rcheck_PE_Non_Transportable_Actual"); + pragma Export (C, Rcheck_SE_Empty_Storage_Pool, + "__gnat_rcheck_SE_Empty_Storage_Pool"); + pragma Export (C, Rcheck_SE_Explicit_Raise, + "__gnat_rcheck_SE_Explicit_Raise"); + pragma Export (C, Rcheck_SE_Infinite_Recursion, + "__gnat_rcheck_SE_Infinite_Recursion"); + pragma Export (C, Rcheck_SE_Object_Too_Large, + "__gnat_rcheck_SE_Object_Too_Large"); + + pragma Export (C, Rcheck_CE_Access_Check_Ext, + "__gnat_rcheck_CE_Access_Check_ext"); + pragma Export (C, Rcheck_CE_Index_Check_Ext, + "__gnat_rcheck_CE_Index_Check_ext"); + pragma Export (C, Rcheck_CE_Invalid_Data_Ext, + "__gnat_rcheck_CE_Invalid_Data_ext"); + pragma Export (C, Rcheck_CE_Range_Check_Ext, + "__gnat_rcheck_CE_Range_Check_ext"); -- None of these procedures ever returns (they raise an exception!). By -- using pragma No_Return, we ensure that any junk code after the call, -- such as normal return epilog stuff, can be eliminated). - pragma No_Return (Rcheck_00); - pragma No_Return (Rcheck_01); - pragma No_Return (Rcheck_02); - pragma No_Return (Rcheck_03); - pragma No_Return (Rcheck_04); - pragma No_Return (Rcheck_05); - pragma No_Return (Rcheck_06); - pragma No_Return (Rcheck_07); - pragma No_Return (Rcheck_08); - pragma No_Return (Rcheck_09); - pragma No_Return (Rcheck_10); - pragma No_Return (Rcheck_11); - pragma No_Return (Rcheck_12); - pragma No_Return (Rcheck_13); - pragma No_Return (Rcheck_14); - pragma No_Return (Rcheck_15); - pragma No_Return (Rcheck_16); - pragma No_Return (Rcheck_17); - pragma No_Return (Rcheck_18); - pragma No_Return (Rcheck_19); - pragma No_Return (Rcheck_20); - pragma No_Return (Rcheck_21); - pragma No_Return (Rcheck_22); - pragma No_Return (Rcheck_23); - pragma No_Return (Rcheck_24); - pragma No_Return (Rcheck_25); - pragma No_Return (Rcheck_26); - pragma No_Return (Rcheck_27); - pragma No_Return (Rcheck_28); - pragma No_Return (Rcheck_29); - pragma No_Return (Rcheck_30); - pragma No_Return (Rcheck_32); - pragma No_Return (Rcheck_33); - pragma No_Return (Rcheck_34); - - pragma No_Return (Rcheck_00_Ext); - pragma No_Return (Rcheck_05_Ext); - pragma No_Return (Rcheck_06_Ext); - pragma No_Return (Rcheck_12_Ext); + pragma No_Return (Rcheck_CE_Access_Check); + pragma No_Return (Rcheck_CE_Null_Access_Parameter); + pragma No_Return (Rcheck_CE_Discriminant_Check); + pragma No_Return (Rcheck_CE_Divide_By_Zero); + pragma No_Return (Rcheck_CE_Explicit_Raise); + pragma No_Return (Rcheck_CE_Index_Check); + pragma No_Return (Rcheck_CE_Invalid_Data); + pragma No_Return (Rcheck_CE_Length_Check); + pragma No_Return (Rcheck_CE_Null_Exception_Id); + pragma No_Return (Rcheck_CE_Null_Not_Allowed); + pragma No_Return (Rcheck_CE_Overflow_Check); + pragma No_Return (Rcheck_CE_Partition_Check); + pragma No_Return (Rcheck_CE_Range_Check); + pragma No_Return (Rcheck_CE_Tag_Check); + pragma No_Return (Rcheck_PE_Access_Before_Elaboration); + pragma No_Return (Rcheck_PE_Accessibility_Check); + pragma No_Return (Rcheck_PE_Address_Of_Intrinsic); + pragma No_Return (Rcheck_PE_All_Guards_Closed); + pragma No_Return (Rcheck_PE_Bad_Predicated_Generic_Type); + pragma No_Return (Rcheck_PE_Current_Task_In_Entry_Body); + pragma No_Return (Rcheck_PE_Duplicated_Entry_Address); + pragma No_Return (Rcheck_PE_Explicit_Raise); + pragma No_Return (Rcheck_PE_Implicit_Return); + pragma No_Return (Rcheck_PE_Misaligned_Address_Value); + pragma No_Return (Rcheck_PE_Missing_Return); + pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object); + pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation); + pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called); + pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction); + pragma No_Return (Rcheck_PE_Non_Transportable_Actual); + pragma No_Return (Rcheck_PE_Finalize_Raised_Exception); + pragma No_Return (Rcheck_SE_Empty_Storage_Pool); + pragma No_Return (Rcheck_SE_Explicit_Raise); + pragma No_Return (Rcheck_SE_Infinite_Recursion); + pragma No_Return (Rcheck_SE_Object_Too_Large); + + pragma No_Return (Rcheck_CE_Access_Check_Ext); + pragma No_Return (Rcheck_CE_Index_Check_Ext); + pragma No_Return (Rcheck_CE_Invalid_Data_Ext); + pragma No_Return (Rcheck_CE_Range_Check_Ext); --------------------------------------------- -- Reason Strings for Run-Time Check Calls -- @@ -1048,182 +1119,252 @@ package body Ada.Exceptions is -- Calls to Run-Time Check Routines -- -------------------------------------- - procedure Rcheck_00 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Access_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_00'Address); - end Rcheck_00; + end Rcheck_CE_Access_Check; - procedure Rcheck_01 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Null_Access_Parameter + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_01'Address); - end Rcheck_01; + end Rcheck_CE_Null_Access_Parameter; - procedure Rcheck_02 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Discriminant_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_02'Address); - end Rcheck_02; + end Rcheck_CE_Discriminant_Check; - procedure Rcheck_03 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Divide_By_Zero + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_03'Address); - end Rcheck_03; + end Rcheck_CE_Divide_By_Zero; - procedure Rcheck_04 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Explicit_Raise + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_04'Address); - end Rcheck_04; + end Rcheck_CE_Explicit_Raise; - procedure Rcheck_05 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Index_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_05'Address); - end Rcheck_05; + end Rcheck_CE_Index_Check; - procedure Rcheck_06 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Invalid_Data + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_06'Address); - end Rcheck_06; + end Rcheck_CE_Invalid_Data; - procedure Rcheck_07 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Length_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_07'Address); - end Rcheck_07; + end Rcheck_CE_Length_Check; - procedure Rcheck_08 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Null_Exception_Id + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_08'Address); - end Rcheck_08; + end Rcheck_CE_Null_Exception_Id; - procedure Rcheck_09 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Null_Not_Allowed + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_09'Address); - end Rcheck_09; + end Rcheck_CE_Null_Not_Allowed; - procedure Rcheck_10 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Overflow_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_10'Address); - end Rcheck_10; + end Rcheck_CE_Overflow_Check; - procedure Rcheck_11 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Partition_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_11'Address); - end Rcheck_11; + end Rcheck_CE_Partition_Check; - procedure Rcheck_12 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Range_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_12'Address); - end Rcheck_12; + end Rcheck_CE_Range_Check; - procedure Rcheck_13 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Tag_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_13'Address); - end Rcheck_13; + end Rcheck_CE_Tag_Check; - procedure Rcheck_14 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Access_Before_Elaboration + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_14'Address); - end Rcheck_14; + end Rcheck_PE_Access_Before_Elaboration; - procedure Rcheck_15 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Accessibility_Check + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_15'Address); - end Rcheck_15; + end Rcheck_PE_Accessibility_Check; - procedure Rcheck_16 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Address_Of_Intrinsic + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_16'Address); - end Rcheck_16; + end Rcheck_PE_Address_Of_Intrinsic; - procedure Rcheck_17 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_All_Guards_Closed + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_17'Address); - end Rcheck_17; + end Rcheck_PE_All_Guards_Closed; - procedure Rcheck_18 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Bad_Predicated_Generic_Type + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_18'Address); - end Rcheck_18; + end Rcheck_PE_Bad_Predicated_Generic_Type; - procedure Rcheck_19 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Current_Task_In_Entry_Body + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_19'Address); - end Rcheck_19; + end Rcheck_PE_Current_Task_In_Entry_Body; - procedure Rcheck_20 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Duplicated_Entry_Address + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_20'Address); - end Rcheck_20; + end Rcheck_PE_Duplicated_Entry_Address; - procedure Rcheck_21 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Explicit_Raise + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_21'Address); - end Rcheck_21; + end Rcheck_PE_Explicit_Raise; - procedure Rcheck_23 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Implicit_Return + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_23'Address); - end Rcheck_23; + end Rcheck_PE_Implicit_Return; - procedure Rcheck_24 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Misaligned_Address_Value + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_24'Address); - end Rcheck_24; + end Rcheck_PE_Misaligned_Address_Value; - procedure Rcheck_25 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Missing_Return + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_25'Address); - end Rcheck_25; + end Rcheck_PE_Missing_Return; - procedure Rcheck_26 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Overlaid_Controlled_Object + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_26'Address); - end Rcheck_26; + end Rcheck_PE_Overlaid_Controlled_Object; - procedure Rcheck_27 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Potentially_Blocking_Operation + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_27'Address); - end Rcheck_27; + end Rcheck_PE_Potentially_Blocking_Operation; - procedure Rcheck_28 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Stubbed_Subprogram_Called + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_28'Address); - end Rcheck_28; + end Rcheck_PE_Stubbed_Subprogram_Called; - procedure Rcheck_29 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Unchecked_Union_Restriction + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_29'Address); - end Rcheck_29; + end Rcheck_PE_Unchecked_Union_Restriction; - procedure Rcheck_30 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_30'Address); - end Rcheck_30; + end Rcheck_PE_Non_Transportable_Actual; - procedure Rcheck_31 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Empty_Storage_Pool + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_31'Address); - end Rcheck_31; + end Rcheck_SE_Empty_Storage_Pool; - procedure Rcheck_32 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Explicit_Raise + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address); - end Rcheck_32; + end Rcheck_SE_Explicit_Raise; - procedure Rcheck_33 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Infinite_Recursion + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address); - end Rcheck_33; + end Rcheck_SE_Infinite_Recursion; - procedure Rcheck_34 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Object_Too_Large + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_34'Address); - end Rcheck_34; + end Rcheck_SE_Object_Too_Large; - procedure Rcheck_00_Ext (File : System.Address; Line, Column : Integer) is + procedure Rcheck_CE_Access_Check_Ext + (File : System.Address; Line, Column : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Column, Rmsg_00'Address); - end Rcheck_00_Ext; + end Rcheck_CE_Access_Check_Ext; - procedure Rcheck_05_Ext + procedure Rcheck_CE_Index_Check_Ext (File : System.Address; Line, Column, Index, First, Last : Integer) is Msg : constant String := @@ -1232,9 +1373,9 @@ package body Ada.Exceptions is ".." & Image (Last) & ASCII.NUL; begin Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); - end Rcheck_05_Ext; + end Rcheck_CE_Index_Check_Ext; - procedure Rcheck_06_Ext + procedure Rcheck_CE_Invalid_Data_Ext (File : System.Address; Line, Column, Index, First, Last : Integer) is Msg : constant String := @@ -1243,9 +1384,9 @@ package body Ada.Exceptions is ".." & Image (Last) & ASCII.NUL; begin Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); - end Rcheck_06_Ext; + end Rcheck_CE_Invalid_Data_Ext; - procedure Rcheck_12_Ext + procedure Rcheck_CE_Range_Check_Ext (File : System.Address; Line, Column, Index, First, Last : Integer) is Msg : constant String := @@ -1254,13 +1395,11 @@ package body Ada.Exceptions is ".." & Image (Last) & ASCII.NUL; begin Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); - end Rcheck_12_Ext; + end Rcheck_CE_Range_Check_Ext; - --------------- - -- Rcheck_22 -- - --------------- - - procedure Rcheck_22 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Finalize_Raised_Exception + (File : System.Address; Line : Integer) + is E : constant Exception_Id := Program_Error_Def'Access; begin @@ -1272,7 +1411,7 @@ package body Ada.Exceptions is Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address); Raise_Current_Excep (E); - end Rcheck_22; + end Rcheck_PE_Finalize_Raised_Exception; ------------- -- Reraise -- diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index fc144bb1c91..6c05b6e6482 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -354,10 +354,198 @@ package body Ada.Exceptions is -- Run-Time Check Routines -- ----------------------------- - -- Routines to a specific exception with a reason message attached. The - -- parameters are the file name and line number in each case. The names are - -- keyed to the codes defined in types.ads and a-types.h (for example, the - -- name Rcheck_05 refers to the Reason RT_Exception_Code'Val (5)). + -- These routines raise a specific exception with a reason message + -- attached. The parameters are the file name and line number in each + -- case. The names are defined by Exp_Ch11.Get_RT_Exception_Name. + + procedure Rcheck_CE_Access_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Null_Access_Parameter + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Discriminant_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Divide_By_Zero + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Explicit_Raise + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Index_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Invalid_Data + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Length_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Null_Exception_Id + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Null_Not_Allowed + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Overflow_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Partition_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Range_Check + (File : System.Address; Line : Integer); + procedure Rcheck_CE_Tag_Check + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Access_Before_Elaboration + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Accessibility_Check + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Address_Of_Intrinsic + (File : System.Address; Line : Integer); + procedure Rcheck_PE_All_Guards_Closed + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Bad_Predicated_Generic_Type + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Current_Task_In_Entry_Body + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Duplicated_Entry_Address + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Explicit_Raise + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Implicit_Return + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Misaligned_Address_Value + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Missing_Return + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Overlaid_Controlled_Object + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Potentially_Blocking_Operation + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Stubbed_Subprogram_Called + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Unchecked_Union_Restriction + (File : System.Address; Line : Integer); + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Empty_Storage_Pool + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Explicit_Raise + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Infinite_Recursion + (File : System.Address; Line : Integer); + procedure Rcheck_SE_Object_Too_Large + (File : System.Address; Line : Integer); + + procedure Rcheck_PE_Finalize_Raised_Exception + (File : System.Address; Line : Integer); + -- This routine is separated out because it has quite different behavior + -- from the others. This is the "finalize/adjust raised exception". This + -- subprogram is always called with abort deferred, unlike all other + -- Rcheck_* routines, it needs to call Raise_Exception_No_Defer. + + pragma Export (C, Rcheck_CE_Access_Check, + "__gnat_rcheck_CE_Access_Check"); + pragma Export (C, Rcheck_CE_Null_Access_Parameter, + "__gnat_rcheck_CE_Null_Access_Parameter"); + pragma Export (C, Rcheck_CE_Discriminant_Check, + "__gnat_rcheck_CE_Discriminant_Check"); + pragma Export (C, Rcheck_CE_Divide_By_Zero, + "__gnat_rcheck_CE_Divide_By_Zero"); + pragma Export (C, Rcheck_CE_Explicit_Raise, + "__gnat_rcheck_CE_Explicit_Raise"); + pragma Export (C, Rcheck_CE_Index_Check, + "__gnat_rcheck_CE_Index_Check"); + pragma Export (C, Rcheck_CE_Invalid_Data, + "__gnat_rcheck_CE_Invalid_Data"); + pragma Export (C, Rcheck_CE_Length_Check, + "__gnat_rcheck_CE_Length_Check"); + pragma Export (C, Rcheck_CE_Null_Exception_Id, + "__gnat_rcheck_CE_Null_Exception_Id"); + pragma Export (C, Rcheck_CE_Null_Not_Allowed, + "__gnat_rcheck_CE_Null_Not_Allowed"); + pragma Export (C, Rcheck_CE_Overflow_Check, + "__gnat_rcheck_CE_Overflow_Check"); + pragma Export (C, Rcheck_CE_Partition_Check, + "__gnat_rcheck_CE_Partition_Check"); + pragma Export (C, Rcheck_CE_Range_Check, + "__gnat_rcheck_CE_Range_Check"); + pragma Export (C, Rcheck_CE_Tag_Check, + "__gnat_rcheck_CE_Tag_Check"); + pragma Export (C, Rcheck_PE_Access_Before_Elaboration, + "__gnat_rcheck_PE_Access_Before_Elaboration"); + pragma Export (C, Rcheck_PE_Accessibility_Check, + "__gnat_rcheck_PE_Accessibility_Check"); + pragma Export (C, Rcheck_PE_Address_Of_Intrinsic, + "__gnat_rcheck_PE_Address_Of_Intrinsic"); + pragma Export (C, Rcheck_PE_All_Guards_Closed, + "__gnat_rcheck_PE_All_Guards_Closed"); + pragma Export (C, Rcheck_PE_Bad_Predicated_Generic_Type, + "__gnat_rcheck_PE_Bad_Predicated_Generic_Type"); + pragma Export (C, Rcheck_PE_Current_Task_In_Entry_Body, + "__gnat_rcheck_PE_Current_Task_In_Entry_Body"); + pragma Export (C, Rcheck_PE_Duplicated_Entry_Address, + "__gnat_rcheck_PE_Duplicated_Entry_Address"); + pragma Export (C, Rcheck_PE_Explicit_Raise, + "__gnat_rcheck_PE_Explicit_Raise"); + pragma Export (C, Rcheck_PE_Finalize_Raised_Exception, + "__gnat_rcheck_PE_Finalize_Raised_Exception"); + pragma Export (C, Rcheck_PE_Implicit_Return, + "__gnat_rcheck_PE_Implicit_Return"); + pragma Export (C, Rcheck_PE_Misaligned_Address_Value, + "__gnat_rcheck_PE_Misaligned_Address_Value"); + pragma Export (C, Rcheck_PE_Missing_Return, + "__gnat_rcheck_PE_Missing_Return"); + pragma Export (C, Rcheck_PE_Overlaid_Controlled_Object, + "__gnat_rcheck_PE_Overlaid_Controlled_Object"); + pragma Export (C, Rcheck_PE_Potentially_Blocking_Operation, + "__gnat_rcheck_PE_Potentially_Blocking_Operation"); + pragma Export (C, Rcheck_PE_Stubbed_Subprogram_Called, + "__gnat_rcheck_PE_Stubbed_Subprogram_Called"); + pragma Export (C, Rcheck_PE_Unchecked_Union_Restriction, + "__gnat_rcheck_PE_Unchecked_Union_Restriction"); + pragma Export (C, Rcheck_PE_Non_Transportable_Actual, + "__gnat_rcheck_PE_Non_Transportable_Actual"); + pragma Export (C, Rcheck_SE_Empty_Storage_Pool, + "__gnat_rcheck_SE_Empty_Storage_Pool"); + pragma Export (C, Rcheck_SE_Explicit_Raise, + "__gnat_rcheck_SE_Explicit_Raise"); + pragma Export (C, Rcheck_SE_Infinite_Recursion, + "__gnat_rcheck_SE_Infinite_Recursion"); + pragma Export (C, Rcheck_SE_Object_Too_Large, + "__gnat_rcheck_SE_Object_Too_Large"); + + -- None of these procedures ever returns (they raise an exception!). By + -- using pragma No_Return, we ensure that any junk code after the call, + -- such as normal return epilog stuff, can be eliminated). + + pragma No_Return (Rcheck_CE_Access_Check); + pragma No_Return (Rcheck_CE_Null_Access_Parameter); + pragma No_Return (Rcheck_CE_Discriminant_Check); + pragma No_Return (Rcheck_CE_Divide_By_Zero); + pragma No_Return (Rcheck_CE_Explicit_Raise); + pragma No_Return (Rcheck_CE_Index_Check); + pragma No_Return (Rcheck_CE_Invalid_Data); + pragma No_Return (Rcheck_CE_Length_Check); + pragma No_Return (Rcheck_CE_Null_Exception_Id); + pragma No_Return (Rcheck_CE_Null_Not_Allowed); + pragma No_Return (Rcheck_CE_Overflow_Check); + pragma No_Return (Rcheck_CE_Partition_Check); + pragma No_Return (Rcheck_CE_Range_Check); + pragma No_Return (Rcheck_CE_Tag_Check); + pragma No_Return (Rcheck_PE_Access_Before_Elaboration); + pragma No_Return (Rcheck_PE_Accessibility_Check); + pragma No_Return (Rcheck_PE_Address_Of_Intrinsic); + pragma No_Return (Rcheck_PE_All_Guards_Closed); + pragma No_Return (Rcheck_PE_Bad_Predicated_Generic_Type); + pragma No_Return (Rcheck_PE_Current_Task_In_Entry_Body); + pragma No_Return (Rcheck_PE_Duplicated_Entry_Address); + pragma No_Return (Rcheck_PE_Explicit_Raise); + pragma No_Return (Rcheck_PE_Implicit_Return); + pragma No_Return (Rcheck_PE_Misaligned_Address_Value); + pragma No_Return (Rcheck_PE_Missing_Return); + pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object); + pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation); + pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called); + pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction); + pragma No_Return (Rcheck_PE_Non_Transportable_Actual); + pragma No_Return (Rcheck_PE_Finalize_Raised_Exception); + pragma No_Return (Rcheck_SE_Empty_Storage_Pool); + pragma No_Return (Rcheck_SE_Explicit_Raise); + pragma No_Return (Rcheck_SE_Infinite_Recursion); + pragma No_Return (Rcheck_SE_Object_Too_Large); + + -- For compatibility with previous version of GNAT, to preserve bootstrap procedure Rcheck_00 (File : System.Address; Line : Integer); procedure Rcheck_01 (File : System.Address; Line : Integer); @@ -395,12 +583,6 @@ package body Ada.Exceptions is procedure Rcheck_34 (File : System.Address; Line : Integer); procedure Rcheck_22 (File : System.Address; Line : Integer); - -- This routine is separated out because it has quite different behavior - -- from the others. This is the "finalize/adjust raised exception". This - -- subprogram is always called with abort deferred, unlike all other - -- Rcheck_* routines, it needs to call Raise_Exception_No_Defer. - -- - -- It should probably have a distinguished name ??? pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); @@ -979,189 +1161,331 @@ package body Ada.Exceptions is -- Calls to Run-Time Check Routines -- -------------------------------------- - procedure Rcheck_00 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Access_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_00'Address); - end Rcheck_00; + end Rcheck_CE_Access_Check; - procedure Rcheck_01 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Null_Access_Parameter + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_01'Address); - end Rcheck_01; + end Rcheck_CE_Null_Access_Parameter; - procedure Rcheck_02 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Discriminant_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_02'Address); - end Rcheck_02; + end Rcheck_CE_Discriminant_Check; - procedure Rcheck_03 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Divide_By_Zero + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_03'Address); - end Rcheck_03; + end Rcheck_CE_Divide_By_Zero; - procedure Rcheck_04 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Explicit_Raise + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_04'Address); - end Rcheck_04; + end Rcheck_CE_Explicit_Raise; - procedure Rcheck_05 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Index_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_05'Address); - end Rcheck_05; + end Rcheck_CE_Index_Check; - procedure Rcheck_06 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Invalid_Data + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_06'Address); - end Rcheck_06; + end Rcheck_CE_Invalid_Data; - procedure Rcheck_07 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Length_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_07'Address); - end Rcheck_07; + end Rcheck_CE_Length_Check; - procedure Rcheck_08 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Null_Exception_Id + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_08'Address); - end Rcheck_08; + end Rcheck_CE_Null_Exception_Id; - procedure Rcheck_09 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Null_Not_Allowed + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_09'Address); - end Rcheck_09; + end Rcheck_CE_Null_Not_Allowed; - procedure Rcheck_10 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Overflow_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_10'Address); - end Rcheck_10; + end Rcheck_CE_Overflow_Check; - procedure Rcheck_11 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Partition_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_11'Address); - end Rcheck_11; + end Rcheck_CE_Partition_Check; - procedure Rcheck_12 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Range_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_12'Address); - end Rcheck_12; + end Rcheck_CE_Range_Check; - procedure Rcheck_13 (File : System.Address; Line : Integer) is + procedure Rcheck_CE_Tag_Check + (File : System.Address; Line : Integer) + is begin Raise_Constraint_Error_Msg (File, Line, Rmsg_13'Address); - end Rcheck_13; + end Rcheck_CE_Tag_Check; - procedure Rcheck_14 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Access_Before_Elaboration + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_14'Address); - end Rcheck_14; + end Rcheck_PE_Access_Before_Elaboration; - procedure Rcheck_15 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Accessibility_Check + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_15'Address); - end Rcheck_15; + end Rcheck_PE_Accessibility_Check; - procedure Rcheck_16 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Address_Of_Intrinsic + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_16'Address); - end Rcheck_16; + end Rcheck_PE_Address_Of_Intrinsic; - procedure Rcheck_17 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_All_Guards_Closed + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_17'Address); - end Rcheck_17; + end Rcheck_PE_All_Guards_Closed; - procedure Rcheck_18 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Bad_Predicated_Generic_Type + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_18'Address); - end Rcheck_18; + end Rcheck_PE_Bad_Predicated_Generic_Type; - procedure Rcheck_19 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Current_Task_In_Entry_Body + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_19'Address); - end Rcheck_19; + end Rcheck_PE_Current_Task_In_Entry_Body; - procedure Rcheck_20 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Duplicated_Entry_Address + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_20'Address); - end Rcheck_20; + end Rcheck_PE_Duplicated_Entry_Address; - procedure Rcheck_21 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Explicit_Raise + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_21'Address); - end Rcheck_21; + end Rcheck_PE_Explicit_Raise; - procedure Rcheck_22 (File : System.Address; Line : Integer) is - E : constant Exception_Id := Program_Error_Def'Access; - - begin - -- This is "finalize/adjust raised exception". This subprogram is always - -- called with abort deferred, unlike all other Rcheck_* routines, it - -- needs to call Raise_Exception_No_Defer. - - -- This is consistent with Raise_From_Controlled_Operation - - Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address); - Raise_Current_Excep (E); - end Rcheck_22; - - procedure Rcheck_23 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Implicit_Return + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_23'Address); - end Rcheck_23; + end Rcheck_PE_Implicit_Return; - procedure Rcheck_24 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Misaligned_Address_Value + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_24'Address); - end Rcheck_24; + end Rcheck_PE_Misaligned_Address_Value; - procedure Rcheck_25 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Missing_Return + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_25'Address); - end Rcheck_25; + end Rcheck_PE_Missing_Return; - procedure Rcheck_26 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Overlaid_Controlled_Object + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_26'Address); - end Rcheck_26; + end Rcheck_PE_Overlaid_Controlled_Object; - procedure Rcheck_27 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Potentially_Blocking_Operation + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_27'Address); - end Rcheck_27; + end Rcheck_PE_Potentially_Blocking_Operation; - procedure Rcheck_28 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Stubbed_Subprogram_Called + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_28'Address); - end Rcheck_28; + end Rcheck_PE_Stubbed_Subprogram_Called; - procedure Rcheck_29 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Unchecked_Union_Restriction + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_29'Address); - end Rcheck_29; + end Rcheck_PE_Unchecked_Union_Restriction; - procedure Rcheck_30 (File : System.Address; Line : Integer) is + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer) + is begin Raise_Program_Error_Msg (File, Line, Rmsg_30'Address); - end Rcheck_30; + end Rcheck_PE_Non_Transportable_Actual; - procedure Rcheck_31 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Empty_Storage_Pool + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_31'Address); - end Rcheck_31; + end Rcheck_SE_Empty_Storage_Pool; - procedure Rcheck_32 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Explicit_Raise + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address); - end Rcheck_32; + end Rcheck_SE_Explicit_Raise; - procedure Rcheck_33 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Infinite_Recursion + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address); - end Rcheck_33; + end Rcheck_SE_Infinite_Recursion; - procedure Rcheck_34 (File : System.Address; Line : Integer) is + procedure Rcheck_SE_Object_Too_Large + (File : System.Address; Line : Integer) + is begin Raise_Storage_Error_Msg (File, Line, Rmsg_34'Address); - end Rcheck_34; + end Rcheck_SE_Object_Too_Large; + + procedure Rcheck_PE_Finalize_Raised_Exception + (File : System.Address; Line : Integer) + is + E : constant Exception_Id := Program_Error_Def'Access; + + begin + -- This is "finalize/adjust raised exception". This subprogram is always + -- called with abort deferred, unlike all other Rcheck_* routines, it + -- needs to call Raise_Exception_No_Defer. + + -- This is consistent with Raise_From_Controlled_Operation + + Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address); + Raise_Current_Excep (E); + end Rcheck_PE_Finalize_Raised_Exception; + + procedure Rcheck_00 (File : System.Address; Line : Integer) + renames Rcheck_CE_Access_Check; + procedure Rcheck_01 (File : System.Address; Line : Integer) + renames Rcheck_CE_Null_Access_Parameter; + procedure Rcheck_02 (File : System.Address; Line : Integer) + renames Rcheck_CE_Discriminant_Check; + procedure Rcheck_03 (File : System.Address; Line : Integer) + renames Rcheck_CE_Divide_By_Zero; + procedure Rcheck_04 (File : System.Address; Line : Integer) + renames Rcheck_CE_Explicit_Raise; + procedure Rcheck_05 (File : System.Address; Line : Integer) + renames Rcheck_CE_Index_Check; + procedure Rcheck_06 (File : System.Address; Line : Integer) + renames Rcheck_CE_Invalid_Data; + procedure Rcheck_07 (File : System.Address; Line : Integer) + renames Rcheck_CE_Length_Check; + procedure Rcheck_08 (File : System.Address; Line : Integer) + renames Rcheck_CE_Null_Exception_Id; + procedure Rcheck_09 (File : System.Address; Line : Integer) + renames Rcheck_CE_Null_Not_Allowed; + procedure Rcheck_10 (File : System.Address; Line : Integer) + renames Rcheck_CE_Overflow_Check; + procedure Rcheck_11 (File : System.Address; Line : Integer) + renames Rcheck_CE_Partition_Check; + procedure Rcheck_12 (File : System.Address; Line : Integer) + renames Rcheck_CE_Range_Check; + procedure Rcheck_13 (File : System.Address; Line : Integer) + renames Rcheck_CE_Tag_Check; + procedure Rcheck_14 (File : System.Address; Line : Integer) + renames Rcheck_PE_Access_Before_Elaboration; + procedure Rcheck_15 (File : System.Address; Line : Integer) + renames Rcheck_PE_Accessibility_Check; + procedure Rcheck_16 (File : System.Address; Line : Integer) + renames Rcheck_PE_Address_Of_Intrinsic; + procedure Rcheck_17 (File : System.Address; Line : Integer) + renames Rcheck_PE_All_Guards_Closed; + procedure Rcheck_18 (File : System.Address; Line : Integer) + renames Rcheck_PE_Bad_Predicated_Generic_Type; + procedure Rcheck_19 (File : System.Address; Line : Integer) + renames Rcheck_PE_Current_Task_In_Entry_Body; + procedure Rcheck_20 (File : System.Address; Line : Integer) + renames Rcheck_PE_Duplicated_Entry_Address; + procedure Rcheck_21 (File : System.Address; Line : Integer) + renames Rcheck_PE_Explicit_Raise; + procedure Rcheck_23 (File : System.Address; Line : Integer) + renames Rcheck_PE_Implicit_Return; + procedure Rcheck_24 (File : System.Address; Line : Integer) + renames Rcheck_PE_Misaligned_Address_Value; + procedure Rcheck_25 (File : System.Address; Line : Integer) + renames Rcheck_PE_Missing_Return; + procedure Rcheck_26 (File : System.Address; Line : Integer) + renames Rcheck_PE_Overlaid_Controlled_Object; + procedure Rcheck_27 (File : System.Address; Line : Integer) + renames Rcheck_PE_Potentially_Blocking_Operation; + procedure Rcheck_28 (File : System.Address; Line : Integer) + renames Rcheck_PE_Stubbed_Subprogram_Called; + procedure Rcheck_29 (File : System.Address; Line : Integer) + renames Rcheck_PE_Unchecked_Union_Restriction; + procedure Rcheck_30 (File : System.Address; Line : Integer) + renames Rcheck_PE_Non_Transportable_Actual; + procedure Rcheck_31 (File : System.Address; Line : Integer) + renames Rcheck_SE_Empty_Storage_Pool; + procedure Rcheck_32 (File : System.Address; Line : Integer) + renames Rcheck_SE_Explicit_Raise; + procedure Rcheck_33 (File : System.Address; Line : Integer) + renames Rcheck_SE_Infinite_Recursion; + procedure Rcheck_34 (File : System.Address; Line : Integer) + renames Rcheck_SE_Object_Too_Large; + + procedure Rcheck_22 (File : System.Address; Line : Integer) + renames Rcheck_PE_Finalize_Raised_Exception; ------------- -- Reraise -- diff --git a/gcc/ada/arit64.c b/gcc/ada/arit64.c index 0ad03960b50..d906ded0d81 100644 --- a/gcc/ada/arit64.c +++ b/gcc/ada/arit64.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2009, Free Software Foundation, Inc. * + * Copyright (C) 2009-2012, 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- * @@ -29,7 +29,7 @@ * * ****************************************************************************/ -extern void __gnat_rcheck_10(char *file, int line) +extern void __gnat_rcheck_CE_Overflow_Check(char *file, int line) __attribute__ ((__noreturn__)); long long int __gnat_mulv64 (long long int x, long long int y) @@ -49,7 +49,7 @@ long long int __gnat_mulv64 (long long int x, long long int y) long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo; if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg) - __gnat_rcheck_10 (__FILE__, __LINE__); + __gnat_rcheck_CE_Overflow_Check (__FILE__, __LINE__); low += ((long long unsigned) (unsigned) mid) << 32; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 67f4a5837df..b90ebfe27aa 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -2023,6 +2023,88 @@ package body Exp_Ch11 is end case; end Get_RT_Exception_Entity; + --------------------------- + -- Get_RT_Exception_Name -- + --------------------------- + + procedure Get_RT_Exception_Name (Code : RT_Exception_Code) is + begin + case Code is + when CE_Access_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Access_Check"); + when CE_Access_Parameter_Is_Null => + Add_Str_To_Name_Buffer ("CE_Null_Access_Parameter"); + when CE_Discriminant_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Discriminant_Check"); + when CE_Divide_By_Zero => + Add_Str_To_Name_Buffer ("CE_Divide_By_Zero"); + when CE_Explicit_Raise => + Add_Str_To_Name_Buffer ("CE_Explicit_Raise"); + when CE_Index_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Index_Check"); + when CE_Invalid_Data => + Add_Str_To_Name_Buffer ("CE_Invalid_Data"); + when CE_Length_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Length_Check"); + when CE_Null_Exception_Id => + Add_Str_To_Name_Buffer ("CE_Null_Exception_Id"); + when CE_Null_Not_Allowed => + Add_Str_To_Name_Buffer ("CE_Null_Not_Allowed"); + when CE_Overflow_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Overflow_Check"); + when CE_Partition_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Partition_Check"); + when CE_Range_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Range_Check"); + when CE_Tag_Check_Failed => + Add_Str_To_Name_Buffer ("CE_Tag_Check"); + + when PE_Access_Before_Elaboration => + Add_Str_To_Name_Buffer ("PE_Access_Before_Elaboration"); + when PE_Accessibility_Check_Failed => + Add_Str_To_Name_Buffer ("PE_Accessibility_Check"); + when PE_Address_Of_Intrinsic => + Add_Str_To_Name_Buffer ("PE_Address_Of_Intrinsic"); + when PE_All_Guards_Closed => + Add_Str_To_Name_Buffer ("PE_All_Guards_Closed"); + when PE_Bad_Predicated_Generic_Type => + Add_Str_To_Name_Buffer ("PE_Bad_Predicated_Generic_Type"); + when PE_Current_Task_In_Entry_Body => + Add_Str_To_Name_Buffer ("PE_Current_Task_In_Entry_Body"); + when PE_Duplicated_Entry_Address => + Add_Str_To_Name_Buffer ("PE_Duplicated_Entry_Address"); + when PE_Explicit_Raise => + Add_Str_To_Name_Buffer ("PE_Explicit_Raise"); + when PE_Finalize_Raised_Exception => + Add_Str_To_Name_Buffer ("PE_Finalize_Raised_Exception"); + when PE_Implicit_Return => + Add_Str_To_Name_Buffer ("PE_Implicit_Return"); + when PE_Misaligned_Address_Value => + Add_Str_To_Name_Buffer ("PE_Misaligned_Address_Value"); + when PE_Missing_Return => + Add_Str_To_Name_Buffer ("PE_Missing_Return"); + when PE_Overlaid_Controlled_Object => + Add_Str_To_Name_Buffer ("PE_Overlaid_Controlled_Object"); + when PE_Potentially_Blocking_Operation => + Add_Str_To_Name_Buffer ("PE_Potentially_Blocking_Operation"); + when PE_Stubbed_Subprogram_Called => + Add_Str_To_Name_Buffer ("PE_Stubbed_Subprogram_Called"); + when PE_Unchecked_Union_Restriction => + Add_Str_To_Name_Buffer ("PE_Unchecked_Union_Restriction"); + when PE_Non_Transportable_Actual => + Add_Str_To_Name_Buffer ("PE_Non_Transportable_Actual"); + + when SE_Empty_Storage_Pool => + Add_Str_To_Name_Buffer ("SE_Empty_Storage_Pool"); + when SE_Explicit_Raise => + Add_Str_To_Name_Buffer ("SE_Explicit_Raise"); + when SE_Infinite_Recursion => + Add_Str_To_Name_Buffer ("SE_Infinite_Recursion"); + when SE_Object_Too_Large => + Add_Str_To_Name_Buffer ("SE_Object_Too_Large"); + end case; + end Get_RT_Exception_Name; + ---------------------- -- Is_Non_Ada_Error -- ---------------------- diff --git a/gcc/ada/exp_ch11.ads b/gcc/ada/exp_ch11.ads index a75a2a807db..f8ebd830649 100644 --- a/gcc/ada/exp_ch11.ads +++ b/gcc/ada/exp_ch11.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -78,6 +78,11 @@ package Exp_Ch11 is -- to determine which Rcheck_nn procedure to call. The returned result is -- the exception entity to be passed to Local_Raise. + procedure Get_RT_Exception_Name (Code : RT_Exception_Code); + -- This procedure is provided for use by the back end to get in the + -- name of the Rcheck procedure for Code. The name is appended to + -- Namet.Name_Buffer, without the __gnat_rcheck_ prefix. + function Is_Non_Ada_Error (E : Entity_Id) return Boolean; -- This function is provided for Gigi use. It returns True if operating on -- VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error. @@ -90,5 +95,4 @@ package Exp_Ch11 is -- handler (and restriction No_Exception_Propagation is set), or if there -- is a local handler marking that it has a local raise. E is the entity -- of the corresponding exception. - end Exp_Ch11; diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index fe6b22dc751..e55253c7ab5 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, 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- * @@ -106,6 +106,7 @@ extern Nat Serious_Errors_Detected; #define Get_Local_Raise_Call_Entity exp_ch11__get_local_raise_call_entity #define Get_RT_Exception_Entity exp_ch11__get_rt_exception_entity +#define Get_RT_Exception_Name exp_ch11__get_rt_exception_name extern Entity_Id Get_Local_Raise_Call_Entity (void); extern Entity_Id Get_RT_Exception_Entity (int); diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index beb13541965..b9b8cd70da1 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -2207,29 +2207,30 @@ ada/exp_ch9.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/exp_util.adb ada/expander.ads ada/fname.ads ada/fname-uf.ads \ ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-byorma.ads \ ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \ - ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-load.ads \ - ada/lib-util.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \ - ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ - ada/opt.adb ada/output.ads ada/put_alfa.ads ada/restrict.ads \ - ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \ - ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \ + ada/interfac.ads ada/itypes.ads ada/layout.ads ada/lib.ads \ + ada/lib-load.ads ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \ + ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ + ada/opt.ads ada/opt.adb ada/output.ads ada/put_alfa.ads \ + ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \ + ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \ ada/sem_aux.adb ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads \ ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads \ ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \ - ada/sem_ch9.ads ada/sem_disp.ads ada/sem_elab.ads ada/sem_eval.ads \ - ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ - ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ - ada/sinput.ads ada/sinput.adb ada/snames.ads ada/sprint.ads \ - ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \ - ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \ - ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ - ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ - ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads + ada/sem_ch9.ads ada/sem_ch9.adb ada/sem_disp.ads ada/sem_elab.ads \ + ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \ + ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \ + ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \ + ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \ + ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ + ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ + ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \ + ada/widechar.ads ada/exp_code.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ @@ -2828,12 +2829,13 @@ ada/gnat1drv.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \ ada/elists.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \ ada/erroutc.ads ada/erroutc.adb ada/exp_cg.ads ada/exp_ch6.ads \ - ada/exp_ch7.ads ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads \ - ada/expander.ads ada/fmap.ads ada/fname.ads ada/fname-uf.ads \ - ada/frontend.ads ada/get_targ.ads ada/gnat.ads ada/g-byorma.ads \ - ada/g-hesorg.ads ada/g-htable.ads ada/g-table.ads ada/g-table.adb \ - ada/gnat1drv.ads ada/gnat1drv.adb ada/gnatvsn.ads ada/hostparm.ads \ - ada/inline.ads ada/inline.adb ada/interfac.ads ada/lib.ads ada/lib.adb \ + ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_disp.ads ada/exp_tss.ads \ + ada/exp_util.ads ada/expander.ads ada/fmap.ads ada/fname.ads \ + ada/fname-uf.ads ada/freeze.ads ada/frontend.ads ada/get_targ.ads \ + ada/gnat.ads ada/g-byorma.ads ada/g-hesorg.ads ada/g-htable.ads \ + ada/g-table.ads ada/g-table.adb ada/gnat1drv.ads ada/gnat1drv.adb \ + ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/inline.adb \ + ada/interfac.ads ada/layout.ads ada/lib.ads ada/lib.adb \ ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads \ ada/lib-writ.ads ada/lib-writ.adb ada/lib-xref.ads ada/namet.ads \ ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \ @@ -2845,22 +2847,23 @@ ada/gnat1drv.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/sem_aux.adb ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads \ ada/sem_ch13.ads ada/sem_ch13.adb ada/sem_ch2.ads ada/sem_ch3.ads \ ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads \ - ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_dim.ads ada/sem_elim.ads \ - ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \ - ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ - ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \ - ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \ - ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \ - ada/s-assert.ads ada/s-bitops.ads ada/s-casuti.ads ada/s-crc32.ads \ - ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ - ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ - ada/targparm.ads ada/tbuild.ads ada/tree_gen.ads ada/tree_io.ads \ - ada/treepr.ads ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \ - ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \ - ada/usage.ads ada/validsw.ads ada/warnsw.ads ada/widechar.ads + ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_ch9.adb ada/sem_dim.ads \ + ada/sem_elim.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads \ + ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/sinput-l.ads \ + ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \ + ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \ + ada/system.ads ada/s-assert.ads ada/s-bitops.ads ada/s-casuti.ads \ + ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \ + ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \ + ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads \ + ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_gen.ads \ + ada/tree_io.ads ada/treepr.ads ada/ttypes.ads ada/types.ads \ + ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/usage.ads ada/validsw.ads \ + ada/warnsw.ads ada/widechar.ads ada/gnatbind.o : ada/ada.ads ada/a-comlin.ads ada/a-clrefi.ads \ ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/ali.ads \ @@ -3670,10 +3673,11 @@ ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \ ada/debug_a.ads ada/debug_a.adb ada/einfo.ads ada/einfo.adb \ ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \ ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/exp_ch7.ads \ - ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \ - ada/fname.ads ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads \ - ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads \ - ada/inline.ads ada/inline.adb ada/interfac.ads ada/lib.ads ada/lib.adb \ + ada/exp_ch9.ads ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads \ + ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \ + ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \ + ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/inline.adb \ + ada/interfac.ads ada/layout.ads ada/lib.ads ada/lib.adb \ ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads \ ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads \ @@ -3683,19 +3687,19 @@ ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \ ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch13.adb ada/sem_ch2.ads \ ada/sem_ch2.adb ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \ ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \ - ada/sem_dim.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads \ - ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ - ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \ - ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \ - ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ - ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ - ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \ - ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/warnsw.ads \ - ada/widechar.ads + ada/sem_ch9.adb ada/sem_dim.ads ada/sem_eval.ads ada/sem_prag.ads \ + ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \ + ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \ + ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \ + ada/stylesw.ads ada/system.ads ada/s-carun8.ads ada/s-exctab.ads \ + ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ + ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ + ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ + ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ + ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/types.adb \ + ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/warnsw.ads ada/widechar.ads ada/sem_aggr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ @@ -4255,23 +4259,24 @@ ada/sem_ch8.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/unchdeal.ads ada/urealp.ads ada/warnsw.ads ada/widechar.ads ada/sem_ch9.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ - ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ - ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \ - ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \ - ada/elists.ads ada/err_vars.ads ada/errout.ads ada/errout.adb \ - ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads ada/exp_ch11.ads \ - ada/exp_ch2.ads ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads \ - ada/exp_ch9.ads ada/exp_code.ads ada/exp_disp.ads ada/exp_pakd.ads \ - ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \ - ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ - ada/g-byorma.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \ - ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \ - ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \ - ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \ - ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ - ada/opt.ads ada/opt.adb ada/output.ads ada/par_sco.ads ada/put_alfa.ads \ - ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \ - ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_aggr.ads ada/sem_attr.ads \ + ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/aspects.adb \ + ada/atree.ads ada/atree.adb ada/casing.ads ada/checks.ads \ + ada/checks.adb ada/csets.ads ada/debug.ads ada/debug_a.ads \ + ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \ + ada/errout.ads ada/errout.adb ada/erroutc.ads ada/erroutc.adb \ + ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch4.ads \ + ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_code.ads \ + ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads \ + ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \ + ada/get_targ.ads ada/gnat.ads ada/g-byorma.ads ada/g-hesorg.ads \ + ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \ + ada/interfac.ads ada/itypes.ads ada/layout.ads ada/lib.ads ada/lib.adb \ + ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads \ + ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ + ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/opt.adb \ + ada/output.ads ada/par_sco.ads ada/put_alfa.ads ada/restrict.ads \ + ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \ + ada/sem.ads ada/sem.adb ada/sem_aggr.ads ada/sem_attr.ads \ ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch10.ads \ ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch13.adb \ ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \ diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index dd1669b7977..d79cd46900d 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -702,12 +702,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, static tree build_raise_check (int check, enum exception_info_kind kind) { - char name[21]; tree result, ftype; + const char pfx[] = "__gnat_rcheck_"; + + strcpy (Name_Buffer, pfx); + Name_Len = sizeof (pfx) - 1; + Get_RT_Exception_Name (check); if (kind == exception_simple) { - sprintf (name, "__gnat_rcheck_%.2d", check); + Name_Buffer[Name_Len] = 0; ftype = build_function_type_list (void_type_node, build_pointer_type @@ -717,7 +721,9 @@ build_raise_check (int check, enum exception_info_kind kind) else { tree t = (kind == exception_column ? NULL_TREE : integer_type_node); - sprintf (name, "__gnat_rcheck_%.2d_ext", check); + + strcpy (Name_Buffer + Name_Len, "_ext"); + Name_Buffer[Name_Len + 4] = 0; ftype = build_function_type_list (void_type_node, build_pointer_type @@ -727,7 +733,8 @@ build_raise_check (int check, enum exception_info_kind kind) } result - = create_subprog_decl (get_identifier (name), NULL_TREE, ftype, NULL_TREE, + = create_subprog_decl (get_identifier (Name_Buffer), + NULL_TREE, ftype, NULL_TREE, false, true, true, true, NULL, Empty); /* Indicate that it never returns. */ diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 75a910d3301..011afda0868 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -764,7 +764,9 @@ package Types is -- 2. Modify the corresponding definitions in types.h, including the -- definition of last_reason_code. - -- 3. Add a new routine in Ada.Exceptions with the appropriate call and + -- 3. Add the name of the routines in exp_ch11.Get_RT_Exception_Name + + -- 4. Add a new routine in Ada.Exceptions with the appropriate call and -- static string constant. Note that there is more than one version -- of a-except.adb which must be modified. -- 2.30.2