Skip to content

R
riscv-gcc-1
Commit 0c644c99 by Tristan Gingold Committed by Arnaud Charlet
Options

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
Showing with 123 additions and 12 deletions
gcc/ada/ChangeLog
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
occurrence only if -gnateE.
(Build_Object_Declaration): Declare E_Id only if -gnateE.
......
gcc/ada/arit64.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 2009, Free Software Foundation, Inc. *
* Copyright (C) 2009-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -29,7 +29,7 @@
* *
****************************************************************************/
extern void __gnat_rcheck_10(char *file, int line)
extern void __gnat_rcheck_CE_Overflow_Check(char *file, int line)
__attribute__ ((__noreturn__));
long long int __gnat_mulv64 (long long int x, long long int y)
......@@ -49,7 +49,7 @@ long long int __gnat_mulv64 (long long int x, long long int y)
long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo;
if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg)
__gnat_rcheck_10 (__FILE__, __LINE__);
__gnat_rcheck_CE_Overflow_Check (__FILE__, __LINE__);
low += ((long long unsigned) (unsigned) mid) << 32;
......
gcc/ada/exp_ch11.adb
......@@ -2023,6 +2023,88 @@ package body Exp_Ch11 is
end case;
end Get_RT_Exception_Entity;
---------------------------
-- Get_RT_Exception_Name --
---------------------------
procedure Get_RT_Exception_Name (Code : RT_Exception_Code) is
begin
case Code is
when CE_Access_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Access_Check");
when CE_Access_Parameter_Is_Null =>
Add_Str_To_Name_Buffer ("CE_Null_Access_Parameter");
when CE_Discriminant_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Discriminant_Check");
when CE_Divide_By_Zero =>
Add_Str_To_Name_Buffer ("CE_Divide_By_Zero");
when CE_Explicit_Raise =>
Add_Str_To_Name_Buffer ("CE_Explicit_Raise");
when CE_Index_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Index_Check");
when CE_Invalid_Data =>
Add_Str_To_Name_Buffer ("CE_Invalid_Data");
when CE_Length_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Length_Check");
when CE_Null_Exception_Id =>
Add_Str_To_Name_Buffer ("CE_Null_Exception_Id");
when CE_Null_Not_Allowed =>
Add_Str_To_Name_Buffer ("CE_Null_Not_Allowed");
when CE_Overflow_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Overflow_Check");
when CE_Partition_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Partition_Check");
when CE_Range_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Range_Check");
when CE_Tag_Check_Failed =>
Add_Str_To_Name_Buffer ("CE_Tag_Check");
when PE_Access_Before_Elaboration =>
Add_Str_To_Name_Buffer ("PE_Access_Before_Elaboration");
when PE_Accessibility_Check_Failed =>
Add_Str_To_Name_Buffer ("PE_Accessibility_Check");
when PE_Address_Of_Intrinsic =>
Add_Str_To_Name_Buffer ("PE_Address_Of_Intrinsic");
when PE_All_Guards_Closed =>
Add_Str_To_Name_Buffer ("PE_All_Guards_Closed");
when PE_Bad_Predicated_Generic_Type =>
Add_Str_To_Name_Buffer ("PE_Bad_Predicated_Generic_Type");
when PE_Current_Task_In_Entry_Body =>
Add_Str_To_Name_Buffer ("PE_Current_Task_In_Entry_Body");
when PE_Duplicated_Entry_Address =>
Add_Str_To_Name_Buffer ("PE_Duplicated_Entry_Address");
when PE_Explicit_Raise =>
Add_Str_To_Name_Buffer ("PE_Explicit_Raise");
when PE_Finalize_Raised_Exception =>
Add_Str_To_Name_Buffer ("PE_Finalize_Raised_Exception");
when PE_Implicit_Return =>
Add_Str_To_Name_Buffer ("PE_Implicit_Return");
when PE_Misaligned_Address_Value =>
Add_Str_To_Name_Buffer ("PE_Misaligned_Address_Value");
when PE_Missing_Return =>
Add_Str_To_Name_Buffer ("PE_Missing_Return");
when PE_Overlaid_Controlled_Object =>
Add_Str_To_Name_Buffer ("PE_Overlaid_Controlled_Object");
when PE_Potentially_Blocking_Operation =>
Add_Str_To_Name_Buffer ("PE_Potentially_Blocking_Operation");
when PE_Stubbed_Subprogram_Called =>
Add_Str_To_Name_Buffer ("PE_Stubbed_Subprogram_Called");
when PE_Unchecked_Union_Restriction =>
Add_Str_To_Name_Buffer ("PE_Unchecked_Union_Restriction");
when PE_Non_Transportable_Actual =>
Add_Str_To_Name_Buffer ("PE_Non_Transportable_Actual");
when SE_Empty_Storage_Pool =>
Add_Str_To_Name_Buffer ("SE_Empty_Storage_Pool");
when SE_Explicit_Raise =>
Add_Str_To_Name_Buffer ("SE_Explicit_Raise");
when SE_Infinite_Recursion =>
Add_Str_To_Name_Buffer ("SE_Infinite_Recursion");
when SE_Object_Too_Large =>
Add_Str_To_Name_Buffer ("SE_Object_Too_Large");
end case;
end Get_RT_Exception_Name;
----------------------
-- Is_Non_Ada_Error --
----------------------
......
gcc/ada/exp_ch11.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -78,6 +78,11 @@ package Exp_Ch11 is
-- to determine which Rcheck_nn procedure to call. The returned result is
-- the exception entity to be passed to Local_Raise.
procedure Get_RT_Exception_Name (Code : RT_Exception_Code);
-- This procedure is provided for use by the back end to get in the
-- name of the Rcheck procedure for Code. The name is appended to
-- Namet.Name_Buffer, without the __gnat_rcheck_ prefix.
function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
-- This function is provided for Gigi use. It returns True if operating on
-- VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
......@@ -90,5 +95,4 @@ package Exp_Ch11 is
-- handler (and restriction No_Exception_Propagation is set), or if there
-- is a local handler marking that it has a local raise. E is the entity
-- of the corresponding exception.
end Exp_Ch11;
gcc/ada/fe.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. *
* Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -106,6 +106,7 @@ extern Nat Serious_Errors_Detected;
#define Get_Local_Raise_Call_Entity exp_ch11__get_local_raise_call_entity
#define Get_RT_Exception_Entity exp_ch11__get_rt_exception_entity
#define Get_RT_Exception_Name exp_ch11__get_rt_exception_name
extern Entity_Id Get_Local_Raise_Call_Entity (void);
extern Entity_Id Get_RT_Exception_Entity (int);
......
gcc/ada/gcc-interface/trans.c
......@@ -702,12 +702,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
static tree
build_raise_check (int check, enum exception_info_kind kind)
{
char name[21];
tree result, ftype;
const char pfx[] = "__gnat_rcheck_";
strcpy (Name_Buffer, pfx);
Name_Len = sizeof (pfx) - 1;
Get_RT_Exception_Name (check);
if (kind == exception_simple)
{
sprintf (name, "__gnat_rcheck_%.2d", check);
Name_Buffer[Name_Len] = 0;
ftype
= build_function_type_list (void_type_node,
build_pointer_type
......@@ -717,7 +721,9 @@ build_raise_check (int check, enum exception_info_kind kind)
else
{
tree t = (kind == exception_column ? NULL_TREE : integer_type_node);
sprintf (name, "__gnat_rcheck_%.2d_ext", check);
strcpy (Name_Buffer + Name_Len, "_ext");
Name_Buffer[Name_Len + 4] = 0;
ftype
= build_function_type_list (void_type_node,
build_pointer_type
......@@ -727,7 +733,8 @@ build_raise_check (int check, enum exception_info_kind kind)
}
result
= create_subprog_decl (get_identifier (name), NULL_TREE, ftype, NULL_TREE,
= create_subprog_decl (get_identifier (Name_Buffer),
NULL_TREE, ftype, NULL_TREE,
false, true, true, true, NULL, Empty);
/* Indicate that it never returns. */
......
gcc/ada/types.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -764,7 +764,9 @@ package Types is
-- 2. Modify the corresponding definitions in types.h, including the
-- definition of last_reason_code.
-- 3. Add a new routine in Ada.Exceptions with the appropriate call and
-- 3. Add the name of the routines in exp_ch11.Get_RT_Exception_Name
-- 4. Add a new routine in Ada.Exceptions with the appropriate call and
-- static string constant. Note that there is more than one version
-- of a-except.adb which must be modified.
......
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