Commit 0c644c99 by Tristan Gingold Committed by Arnaud Charlet

fe.h (Get_RT_Exception_Name): Define.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* 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
parent a2f6dee8
2012-05-15 Tristan Gingold <gingold@adacore.com> 2012-05-15 Tristan Gingold <gingold@adacore.com>
* 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 <gingold@adacore.com>
* exp_ch7.adb (Build_Exception_Handler): Save current * exp_ch7.adb (Build_Exception_Handler): Save current
occurrence only if -gnateE. occurrence only if -gnateE.
(Build_Object_Declaration): Declare E_Id only if -gnateE. (Build_Object_Declaration): Declare E_Id only if -gnateE.
......
...@@ -396,146 +396,217 @@ package body Ada.Exceptions is ...@@ -396,146 +396,217 @@ package body Ada.Exceptions is
-- These routines raise a specific exception with a reason message -- These routines raise a specific exception with a reason message
-- attached. The parameters are the file name and line number in each -- 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 -- case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
-- a-types.h (for example, the name Rcheck_05 refers to the Reason
-- RT_Exception_Code'Val (5)). procedure Rcheck_CE_Access_Check
(File : System.Address; Line : Integer);
procedure Rcheck_00 (File : System.Address; Line : Integer); procedure Rcheck_CE_Null_Access_Parameter
procedure Rcheck_01 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_02 (File : System.Address; Line : Integer); procedure Rcheck_CE_Discriminant_Check
procedure Rcheck_03 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_04 (File : System.Address; Line : Integer); procedure Rcheck_CE_Divide_By_Zero
procedure Rcheck_05 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_06 (File : System.Address; Line : Integer); procedure Rcheck_CE_Explicit_Raise
procedure Rcheck_07 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_08 (File : System.Address; Line : Integer); procedure Rcheck_CE_Index_Check
procedure Rcheck_09 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_10 (File : System.Address; Line : Integer); procedure Rcheck_CE_Invalid_Data
procedure Rcheck_11 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_12 (File : System.Address; Line : Integer); procedure Rcheck_CE_Length_Check
procedure Rcheck_13 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_14 (File : System.Address; Line : Integer); procedure Rcheck_CE_Null_Exception_Id
procedure Rcheck_15 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_16 (File : System.Address; Line : Integer); procedure Rcheck_CE_Null_Not_Allowed
procedure Rcheck_17 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_18 (File : System.Address; Line : Integer); procedure Rcheck_CE_Overflow_Check
procedure Rcheck_19 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_20 (File : System.Address; Line : Integer); procedure Rcheck_CE_Partition_Check
procedure Rcheck_21 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_23 (File : System.Address; Line : Integer); procedure Rcheck_CE_Range_Check
procedure Rcheck_24 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_25 (File : System.Address; Line : Integer); procedure Rcheck_CE_Tag_Check
procedure Rcheck_26 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_27 (File : System.Address; Line : Integer); procedure Rcheck_PE_Access_Before_Elaboration
procedure Rcheck_28 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_29 (File : System.Address; Line : Integer); procedure Rcheck_PE_Accessibility_Check
procedure Rcheck_30 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_31 (File : System.Address; Line : Integer); procedure Rcheck_PE_Address_Of_Intrinsic
procedure Rcheck_32 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_33 (File : System.Address; Line : Integer); procedure Rcheck_PE_All_Guards_Closed
procedure Rcheck_34 (File : System.Address; Line : Integer); (File : System.Address; Line : Integer);
procedure Rcheck_PE_Bad_Predicated_Generic_Type
procedure Rcheck_00_Ext (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); (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); (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); (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); (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 -- This routine is separated out because it has quite different behavior
-- from the others. This is the "finalize/adjust raised exception". This -- from the others. This is the "finalize/adjust raised exception". This
-- subprogram is always called with abort deferred, unlike all other -- subprogram is always called with abort deferred, unlike all other
-- Rcheck_* routines, it needs to call Raise_Exception_No_Defer. -- Rcheck_* routines, it needs to call Raise_Exception_No_Defer.
--
-- It should probably have a distinguished name ??? pragma Export (C, Rcheck_CE_Access_Check,
"__gnat_rcheck_CE_Access_Check");
pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); pragma Export (C, Rcheck_CE_Null_Access_Parameter,
pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); "__gnat_rcheck_CE_Null_Access_Parameter");
pragma Export (C, Rcheck_02, "__gnat_rcheck_02"); pragma Export (C, Rcheck_CE_Discriminant_Check,
pragma Export (C, Rcheck_03, "__gnat_rcheck_03"); "__gnat_rcheck_CE_Discriminant_Check");
pragma Export (C, Rcheck_04, "__gnat_rcheck_04"); pragma Export (C, Rcheck_CE_Divide_By_Zero,
pragma Export (C, Rcheck_05, "__gnat_rcheck_05"); "__gnat_rcheck_CE_Divide_By_Zero");
pragma Export (C, Rcheck_06, "__gnat_rcheck_06"); pragma Export (C, Rcheck_CE_Explicit_Raise,
pragma Export (C, Rcheck_07, "__gnat_rcheck_07"); "__gnat_rcheck_CE_Explicit_Raise");
pragma Export (C, Rcheck_08, "__gnat_rcheck_08"); pragma Export (C, Rcheck_CE_Index_Check,
pragma Export (C, Rcheck_09, "__gnat_rcheck_09"); "__gnat_rcheck_CE_Index_Check");
pragma Export (C, Rcheck_10, "__gnat_rcheck_10"); pragma Export (C, Rcheck_CE_Invalid_Data,
pragma Export (C, Rcheck_11, "__gnat_rcheck_11"); "__gnat_rcheck_CE_Invalid_Data");
pragma Export (C, Rcheck_12, "__gnat_rcheck_12"); pragma Export (C, Rcheck_CE_Length_Check,
pragma Export (C, Rcheck_13, "__gnat_rcheck_13"); "__gnat_rcheck_CE_Length_Check");
pragma Export (C, Rcheck_14, "__gnat_rcheck_14"); pragma Export (C, Rcheck_CE_Null_Exception_Id,
pragma Export (C, Rcheck_15, "__gnat_rcheck_15"); "__gnat_rcheck_CE_Null_Exception_Id");
pragma Export (C, Rcheck_16, "__gnat_rcheck_16"); pragma Export (C, Rcheck_CE_Null_Not_Allowed,
pragma Export (C, Rcheck_17, "__gnat_rcheck_17"); "__gnat_rcheck_CE_Null_Not_Allowed");
pragma Export (C, Rcheck_18, "__gnat_rcheck_18"); pragma Export (C, Rcheck_CE_Overflow_Check,
pragma Export (C, Rcheck_19, "__gnat_rcheck_19"); "__gnat_rcheck_CE_Overflow_Check");
pragma Export (C, Rcheck_20, "__gnat_rcheck_20"); pragma Export (C, Rcheck_CE_Partition_Check,
pragma Export (C, Rcheck_21, "__gnat_rcheck_21"); "__gnat_rcheck_CE_Partition_Check");
pragma Export (C, Rcheck_22, "__gnat_rcheck_22"); pragma Export (C, Rcheck_CE_Range_Check,
pragma Export (C, Rcheck_23, "__gnat_rcheck_23"); "__gnat_rcheck_CE_Range_Check");
pragma Export (C, Rcheck_24, "__gnat_rcheck_24"); pragma Export (C, Rcheck_CE_Tag_Check,
pragma Export (C, Rcheck_25, "__gnat_rcheck_25"); "__gnat_rcheck_CE_Tag_Check");
pragma Export (C, Rcheck_26, "__gnat_rcheck_26"); pragma Export (C, Rcheck_PE_Access_Before_Elaboration,
pragma Export (C, Rcheck_27, "__gnat_rcheck_27"); "__gnat_rcheck_PE_Access_Before_Elaboration");
pragma Export (C, Rcheck_28, "__gnat_rcheck_28"); pragma Export (C, Rcheck_PE_Accessibility_Check,
pragma Export (C, Rcheck_29, "__gnat_rcheck_29"); "__gnat_rcheck_PE_Accessibility_Check");
pragma Export (C, Rcheck_30, "__gnat_rcheck_30"); pragma Export (C, Rcheck_PE_Address_Of_Intrinsic,
pragma Export (C, Rcheck_31, "__gnat_rcheck_31"); "__gnat_rcheck_PE_Address_Of_Intrinsic");
pragma Export (C, Rcheck_32, "__gnat_rcheck_32"); pragma Export (C, Rcheck_PE_All_Guards_Closed,
pragma Export (C, Rcheck_33, "__gnat_rcheck_33"); "__gnat_rcheck_PE_All_Guards_Closed");
pragma Export (C, Rcheck_34, "__gnat_rcheck_34"); pragma Export (C, Rcheck_PE_Bad_Predicated_Generic_Type,
"__gnat_rcheck_PE_Bad_Predicated_Generic_Type");
pragma Export (C, Rcheck_00_Ext, "__gnat_rcheck_00_ext"); pragma Export (C, Rcheck_PE_Current_Task_In_Entry_Body,
pragma Export (C, Rcheck_05_Ext, "__gnat_rcheck_05_ext"); "__gnat_rcheck_PE_Current_Task_In_Entry_Body");
pragma Export (C, Rcheck_06_Ext, "__gnat_rcheck_06_ext"); pragma Export (C, Rcheck_PE_Duplicated_Entry_Address,
pragma Export (C, Rcheck_12_Ext, "__gnat_rcheck_12_ext"); "__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 -- None of these procedures ever returns (they raise an exception!). By
-- using pragma No_Return, we ensure that any junk code after the call, -- using pragma No_Return, we ensure that any junk code after the call,
-- such as normal return epilog stuff, can be eliminated). -- such as normal return epilog stuff, can be eliminated).
pragma No_Return (Rcheck_00); pragma No_Return (Rcheck_CE_Access_Check);
pragma No_Return (Rcheck_01); pragma No_Return (Rcheck_CE_Null_Access_Parameter);
pragma No_Return (Rcheck_02); pragma No_Return (Rcheck_CE_Discriminant_Check);
pragma No_Return (Rcheck_03); pragma No_Return (Rcheck_CE_Divide_By_Zero);
pragma No_Return (Rcheck_04); pragma No_Return (Rcheck_CE_Explicit_Raise);
pragma No_Return (Rcheck_05); pragma No_Return (Rcheck_CE_Index_Check);
pragma No_Return (Rcheck_06); pragma No_Return (Rcheck_CE_Invalid_Data);
pragma No_Return (Rcheck_07); pragma No_Return (Rcheck_CE_Length_Check);
pragma No_Return (Rcheck_08); pragma No_Return (Rcheck_CE_Null_Exception_Id);
pragma No_Return (Rcheck_09); pragma No_Return (Rcheck_CE_Null_Not_Allowed);
pragma No_Return (Rcheck_10); pragma No_Return (Rcheck_CE_Overflow_Check);
pragma No_Return (Rcheck_11); pragma No_Return (Rcheck_CE_Partition_Check);
pragma No_Return (Rcheck_12); pragma No_Return (Rcheck_CE_Range_Check);
pragma No_Return (Rcheck_13); pragma No_Return (Rcheck_CE_Tag_Check);
pragma No_Return (Rcheck_14); pragma No_Return (Rcheck_PE_Access_Before_Elaboration);
pragma No_Return (Rcheck_15); pragma No_Return (Rcheck_PE_Accessibility_Check);
pragma No_Return (Rcheck_16); pragma No_Return (Rcheck_PE_Address_Of_Intrinsic);
pragma No_Return (Rcheck_17); pragma No_Return (Rcheck_PE_All_Guards_Closed);
pragma No_Return (Rcheck_18); pragma No_Return (Rcheck_PE_Bad_Predicated_Generic_Type);
pragma No_Return (Rcheck_19); pragma No_Return (Rcheck_PE_Current_Task_In_Entry_Body);
pragma No_Return (Rcheck_20); pragma No_Return (Rcheck_PE_Duplicated_Entry_Address);
pragma No_Return (Rcheck_21); pragma No_Return (Rcheck_PE_Explicit_Raise);
pragma No_Return (Rcheck_22); pragma No_Return (Rcheck_PE_Implicit_Return);
pragma No_Return (Rcheck_23); pragma No_Return (Rcheck_PE_Misaligned_Address_Value);
pragma No_Return (Rcheck_24); pragma No_Return (Rcheck_PE_Missing_Return);
pragma No_Return (Rcheck_25); pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object);
pragma No_Return (Rcheck_26); pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation);
pragma No_Return (Rcheck_27); pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called);
pragma No_Return (Rcheck_28); pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction);
pragma No_Return (Rcheck_29); pragma No_Return (Rcheck_PE_Non_Transportable_Actual);
pragma No_Return (Rcheck_30); pragma No_Return (Rcheck_PE_Finalize_Raised_Exception);
pragma No_Return (Rcheck_32); pragma No_Return (Rcheck_SE_Empty_Storage_Pool);
pragma No_Return (Rcheck_33); pragma No_Return (Rcheck_SE_Explicit_Raise);
pragma No_Return (Rcheck_34); pragma No_Return (Rcheck_SE_Infinite_Recursion);
pragma No_Return (Rcheck_SE_Object_Too_Large);
pragma No_Return (Rcheck_00_Ext);
pragma No_Return (Rcheck_05_Ext); pragma No_Return (Rcheck_CE_Access_Check_Ext);
pragma No_Return (Rcheck_06_Ext); pragma No_Return (Rcheck_CE_Index_Check_Ext);
pragma No_Return (Rcheck_12_Ext); pragma No_Return (Rcheck_CE_Invalid_Data_Ext);
pragma No_Return (Rcheck_CE_Range_Check_Ext);
--------------------------------------------- ---------------------------------------------
-- Reason Strings for Run-Time Check Calls -- -- Reason Strings for Run-Time Check Calls --
...@@ -1048,182 +1119,252 @@ package body Ada.Exceptions is ...@@ -1048,182 +1119,252 @@ package body Ada.Exceptions is
-- Calls to Run-Time Check Routines -- -- 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_00'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_01'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_02'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_03'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_04'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_05'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_06'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_07'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_08'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_09'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_10'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_11'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_12'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, 0, Rmsg_13'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_14'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_15'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_16'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_17'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_18'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_19'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_20'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_21'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_23'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_24'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_25'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_26'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_27'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_28'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_29'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_30'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_31'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_34'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Column, Rmsg_00'Address); 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) (File : System.Address; Line, Column, Index, First, Last : Integer)
is is
Msg : constant String := Msg : constant String :=
...@@ -1232,9 +1373,9 @@ package body Ada.Exceptions is ...@@ -1232,9 +1373,9 @@ package body Ada.Exceptions is
".." & Image (Last) & ASCII.NUL; ".." & Image (Last) & ASCII.NUL;
begin begin
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); 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) (File : System.Address; Line, Column, Index, First, Last : Integer)
is is
Msg : constant String := Msg : constant String :=
...@@ -1243,9 +1384,9 @@ package body Ada.Exceptions is ...@@ -1243,9 +1384,9 @@ package body Ada.Exceptions is
".." & Image (Last) & ASCII.NUL; ".." & Image (Last) & ASCII.NUL;
begin begin
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); 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) (File : System.Address; Line, Column, Index, First, Last : Integer)
is is
Msg : constant String := Msg : constant String :=
...@@ -1254,13 +1395,11 @@ package body Ada.Exceptions is ...@@ -1254,13 +1395,11 @@ package body Ada.Exceptions is
".." & Image (Last) & ASCII.NUL; ".." & Image (Last) & ASCII.NUL;
begin begin
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
end Rcheck_12_Ext; end Rcheck_CE_Range_Check_Ext;
--------------- procedure Rcheck_PE_Finalize_Raised_Exception
-- Rcheck_22 -- (File : System.Address; Line : Integer)
--------------- is
procedure Rcheck_22 (File : System.Address; Line : Integer) is
E : constant Exception_Id := Program_Error_Def'Access; E : constant Exception_Id := Program_Error_Def'Access;
begin begin
...@@ -1272,7 +1411,7 @@ package body Ada.Exceptions is ...@@ -1272,7 +1411,7 @@ package body Ada.Exceptions is
Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address); Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
Raise_Current_Excep (E); Raise_Current_Excep (E);
end Rcheck_22; end Rcheck_PE_Finalize_Raised_Exception;
------------- -------------
-- Reraise -- -- Reraise --
......
...@@ -354,10 +354,198 @@ package body Ada.Exceptions is ...@@ -354,10 +354,198 @@ package body Ada.Exceptions is
-- Run-Time Check Routines -- -- Run-Time Check Routines --
----------------------------- -----------------------------
-- Routines to a specific exception with a reason message attached. The -- These routines raise a specific exception with a reason message
-- parameters are the file name and line number in each case. The names are -- attached. The parameters are the file name and line number in each
-- keyed to the codes defined in types.ads and a-types.h (for example, the -- case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
-- name Rcheck_05 refers to the Reason RT_Exception_Code'Val (5)).
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_00 (File : System.Address; Line : Integer);
procedure Rcheck_01 (File : System.Address; Line : Integer); procedure Rcheck_01 (File : System.Address; Line : Integer);
...@@ -395,12 +583,6 @@ package body Ada.Exceptions is ...@@ -395,12 +583,6 @@ package body Ada.Exceptions is
procedure Rcheck_34 (File : System.Address; Line : Integer); procedure Rcheck_34 (File : System.Address; Line : Integer);
procedure Rcheck_22 (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_00, "__gnat_rcheck_00");
pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
...@@ -979,189 +1161,331 @@ package body Ada.Exceptions is ...@@ -979,189 +1161,331 @@ package body Ada.Exceptions is
-- Calls to Run-Time Check Routines -- -- 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_00'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_01'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_02'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_03'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_04'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_05'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_06'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_07'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_08'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_09'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_10'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_11'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_12'Address); 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 begin
Raise_Constraint_Error_Msg (File, Line, Rmsg_13'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_14'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_15'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_16'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_17'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_18'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_19'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_20'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_21'Address); 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 procedure Rcheck_PE_Implicit_Return
E : constant Exception_Id := Program_Error_Def'Access; (File : System.Address; Line : Integer)
is
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
begin begin
Raise_Program_Error_Msg (File, Line, Rmsg_23'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_24'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_25'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_26'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_27'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_28'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_29'Address); 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 begin
Raise_Program_Error_Msg (File, Line, Rmsg_30'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_31'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address); 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 begin
Raise_Storage_Error_Msg (File, Line, Rmsg_34'Address); 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 -- -- Reraise --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * 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 * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -29,7 +29,7 @@ ...@@ -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__)); __attribute__ ((__noreturn__));
long long int __gnat_mulv64 (long long int x, long long int y) 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) ...@@ -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; long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo;
if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg) 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; low += ((long long unsigned) (unsigned) mid) << 32;
......
...@@ -2023,6 +2023,88 @@ package body Exp_Ch11 is ...@@ -2023,6 +2023,88 @@ package body Exp_Ch11 is
end case; end case;
end Get_RT_Exception_Entity; 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 -- -- Is_Non_Ada_Error --
---------------------- ----------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -78,6 +78,11 @@ package Exp_Ch11 is ...@@ -78,6 +78,11 @@ package Exp_Ch11 is
-- to determine which Rcheck_nn procedure to call. The returned result is -- to determine which Rcheck_nn procedure to call. The returned result is
-- the exception entity to be passed to Local_Raise. -- 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; function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
-- This function is provided for Gigi use. It returns True if operating on -- 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. -- VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
...@@ -90,5 +95,4 @@ package Exp_Ch11 is ...@@ -90,5 +95,4 @@ package Exp_Ch11 is
-- handler (and restriction No_Exception_Propagation is set), or if there -- 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 -- is a local handler marking that it has a local raise. E is the entity
-- of the corresponding exception. -- of the corresponding exception.
end Exp_Ch11; end Exp_Ch11;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * 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 * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -106,6 +106,7 @@ extern Nat Serious_Errors_Detected; ...@@ -106,6 +106,7 @@ extern Nat Serious_Errors_Detected;
#define Get_Local_Raise_Call_Entity exp_ch11__get_local_raise_call_entity #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_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_Local_Raise_Call_Entity (void);
extern Entity_Id Get_RT_Exception_Entity (int); extern Entity_Id Get_RT_Exception_Entity (int);
......
...@@ -2207,29 +2207,30 @@ ada/exp_ch9.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ...@@ -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/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/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/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/interfac.ads ada/itypes.ads ada/layout.ads ada/lib.ads \
ada/lib-util.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \ ada/lib-load.ads ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
ada/opt.adb ada/output.ads ada/put_alfa.ads ada/restrict.ads \ ada/opt.ads ada/opt.adb ada/output.ads ada/put_alfa.ads \
ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \ ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.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_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_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_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_ch9.ads ada/sem_ch9.adb ada/sem_disp.ads ada/sem_elab.ads \
ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \
ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
ada/sinput.ads ada/sinput.adb ada/snames.ads ada/sprint.ads \ ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \ ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \
ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \ ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.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/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 \ 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 \ ...@@ -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/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/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/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/exp_ch7.ads ada/exp_ch9.ads ada/exp_disp.ads ada/exp_tss.ads \
ada/expander.ads ada/fmap.ads ada/fname.ads ada/fname-uf.ads \ ada/exp_util.ads ada/expander.ads ada/fmap.ads ada/fname.ads \
ada/frontend.ads ada/get_targ.ads ada/gnat.ads ada/g-byorma.ads \ ada/fname-uf.ads ada/freeze.ads ada/frontend.ads ada/get_targ.ads \
ada/g-hesorg.ads ada/g-htable.ads ada/g-table.ads ada/g-table.adb \ ada/gnat.ads ada/g-byorma.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/gnat1drv.ads ada/gnat1drv.adb ada/gnatvsn.ads ada/hostparm.ads \ ada/g-table.ads ada/g-table.adb ada/gnat1drv.ads ada/gnat1drv.adb \
ada/inline.ads ada/inline.adb ada/interfac.ads ada/lib.ads ada/lib.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-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/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 \ 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 \ ...@@ -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_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_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_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_ch8.ads ada/sem_ch9.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_elim.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads \
ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \ ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/sinput-l.ads \
ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \ ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \ ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
ada/s-assert.ads ada/s-bitops.ads ada/s-casuti.ads ada/s-crc32.ads \ ada/system.ads ada/s-assert.ads ada/s-bitops.ads ada/s-casuti.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads \
ada/targparm.ads ada/tbuild.ads ada/tree_gen.ads ada/tree_io.ads \ ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_gen.ads \
ada/treepr.ads ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \ ada/tree_io.ads ada/treepr.ads ada/ttypes.ads ada/types.ads \
ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \ ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/usage.ads ada/validsw.ads ada/warnsw.ads ada/widechar.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/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 \ 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 \ ...@@ -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/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/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/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/exp_ch9.ads ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads \
ada/fname.ads ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads \ ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads \ ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/inline.ads ada/inline.adb ada/interfac.ads ada/lib.ads ada/lib.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-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/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.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 \ ...@@ -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_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_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_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_ch9.adb ada/sem_dim.ads ada/sem_eval.ads ada/sem_prag.ads \
ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.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/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ ada/stylesw.ads ada/system.ads ada/s-carun8.ads ada/s-exctab.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \ ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \ ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/types.adb \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/warnsw.ads \ ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/widechar.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/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 \ 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 \ ...@@ -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/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/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/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/aspects.adb \
ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \ ada/atree.ads ada/atree.adb ada/casing.ads ada/checks.ads \
ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \ ada/checks.adb ada/csets.ads ada/debug.ads ada/debug_a.ads \
ada/elists.ads ada/err_vars.ads ada/errout.ads ada/errout.adb \ ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads ada/exp_ch11.ads \ ada/errout.ads ada/errout.adb ada/erroutc.ads ada/erroutc.adb \
ada/exp_ch2.ads ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads \ ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch4.ads \
ada/exp_ch9.ads ada/exp_code.ads ada/exp_disp.ads ada/exp_pakd.ads \ ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_code.ads \
ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \ ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads \
ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
ada/g-byorma.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \ ada/get_targ.ads ada/gnat.ads ada/g-byorma.ads ada/g-hesorg.ads \
ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \ ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \ ada/interfac.ads ada/itypes.ads ada/layout.ads ada/lib.ads ada/lib.adb \
ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \ ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads \
ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/opt.ads ada/opt.adb ada/output.ads ada/par_sco.ads ada/put_alfa.ads \ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/opt.adb \
ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \ ada/output.ads ada/par_sco.ads ada/put_alfa.ads ada/restrict.ads \
ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_aggr.ads ada/sem_attr.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_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_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_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
......
...@@ -702,12 +702,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, ...@@ -702,12 +702,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
static tree static tree
build_raise_check (int check, enum exception_info_kind kind) build_raise_check (int check, enum exception_info_kind kind)
{ {
char name[21];
tree result, ftype; 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) if (kind == exception_simple)
{ {
sprintf (name, "__gnat_rcheck_%.2d", check); Name_Buffer[Name_Len] = 0;
ftype ftype
= build_function_type_list (void_type_node, = build_function_type_list (void_type_node,
build_pointer_type build_pointer_type
...@@ -717,7 +721,9 @@ build_raise_check (int check, enum exception_info_kind kind) ...@@ -717,7 +721,9 @@ build_raise_check (int check, enum exception_info_kind kind)
else else
{ {
tree t = (kind == exception_column ? NULL_TREE : integer_type_node); 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 ftype
= build_function_type_list (void_type_node, = build_function_type_list (void_type_node,
build_pointer_type build_pointer_type
...@@ -727,7 +733,8 @@ build_raise_check (int check, enum exception_info_kind kind) ...@@ -727,7 +733,8 @@ build_raise_check (int check, enum exception_info_kind kind)
} }
result 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); false, true, true, true, NULL, Empty);
/* Indicate that it never returns. */ /* Indicate that it never returns. */
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -764,7 +764,9 @@ package Types is ...@@ -764,7 +764,9 @@ package Types is
-- 2. Modify the corresponding definitions in types.h, including the -- 2. Modify the corresponding definitions in types.h, including the
-- definition of last_reason_code. -- 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 -- static string constant. Note that there is more than one version
-- of a-except.adb which must be modified. -- of a-except.adb which must be modified.
......
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