git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Tristan Gingold 2012-05-15 10:17:26 +00:00 committed by Arnaud Charlet
parent a2f6dee8a9
commit 0c644c99db
10 changed files with 984 additions and 405 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/ChangeLog
View File

@ -1,3 +1,18 @@
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

545
gcc/ada/a-except-2005.adb
View File

@ -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)).
-- case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
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_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_00_Ext
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_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_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_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_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_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_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 --

552
gcc/ada/a-except.adb
View File

@ -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,117 +1161,247 @@ 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
procedure Rcheck_PE_Implicit_Return
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_23'Address);
end Rcheck_PE_Implicit_Return;
procedure Rcheck_PE_Misaligned_Address_Value
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_24'Address);
end Rcheck_PE_Misaligned_Address_Value;
procedure Rcheck_PE_Missing_Return
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_25'Address);
end Rcheck_PE_Missing_Return;
procedure Rcheck_PE_Overlaid_Controlled_Object
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_26'Address);
end Rcheck_PE_Overlaid_Controlled_Object;
procedure Rcheck_PE_Potentially_Blocking_Operation
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_27'Address);
end Rcheck_PE_Potentially_Blocking_Operation;
procedure Rcheck_PE_Stubbed_Subprogram_Called
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
end Rcheck_PE_Stubbed_Subprogram_Called;
procedure Rcheck_PE_Unchecked_Union_Restriction
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_29'Address);
end Rcheck_PE_Unchecked_Union_Restriction;
procedure Rcheck_PE_Non_Transportable_Actual
(File : System.Address; Line : Integer)
is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_30'Address);
end Rcheck_PE_Non_Transportable_Actual;
procedure Rcheck_SE_Empty_Storage_Pool
(File : System.Address; Line : Integer)
is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_31'Address);
end Rcheck_SE_Empty_Storage_Pool;
procedure Rcheck_SE_Explicit_Raise
(File : System.Address; Line : Integer)
is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address);
end Rcheck_SE_Explicit_Raise;
procedure Rcheck_SE_Infinite_Recursion
(File : System.Address; Line : Integer)
is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address);
end Rcheck_SE_Infinite_Recursion;
procedure Rcheck_SE_Object_Too_Large
(File : System.Address; Line : Integer)
is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_34'Address);
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
@ -1101,67 +1413,79 @@ 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;
procedure Rcheck_23 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_23'Address);
end Rcheck_23;
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_24 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_24'Address);
end Rcheck_24;
procedure Rcheck_25 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_25'Address);
end Rcheck_25;
procedure Rcheck_26 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_26'Address);
end Rcheck_26;
procedure Rcheck_27 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_27'Address);
end Rcheck_27;
procedure Rcheck_28 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
end Rcheck_28;
procedure Rcheck_29 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_29'Address);
end Rcheck_29;
procedure Rcheck_30 (File : System.Address; Line : Integer) is
begin
Raise_Program_Error_Msg (File, Line, Rmsg_30'Address);
end Rcheck_30;
procedure Rcheck_31 (File : System.Address; Line : Integer) is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_31'Address);
end Rcheck_31;
procedure Rcheck_32 (File : System.Address; Line : Integer) is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address);
end Rcheck_32;
procedure Rcheck_33 (File : System.Address; Line : Integer) is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address);
end Rcheck_33;
procedure Rcheck_34 (File : System.Address; Line : Integer) is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_34'Address);
end Rcheck_34;
procedure Rcheck_22 (File : System.Address; Line : Integer)
renames Rcheck_PE_Finalize_Raised_Exception;
-------------
-- Reraise --

6
gcc/ada/arit64.c
View File

@ -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;

82
gcc/ada/exp_ch11.adb
View File

@ -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 --
----------------------

8
gcc/ada/exp_ch11.ads
View File

@ -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;

3
gcc/ada/fe.h
View File

@ -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);

157
gcc/ada/gcc-interface/Make-lang.in
View File

@ -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 \

15
gcc/ada/gcc-interface/trans.c
View File

@ -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. */

6
gcc/ada/types.ads
View File

@ -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.