From 5accd7b6ca81d3f3b399bf55e201fc6f78771a13 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 29 Aug 2011 13:06:09 +0200 Subject: [multiple changes] 2011-08-29 Yannick Moy * sem_ch13.adb (Analyze_Aspect_Specifications): Reject test-case on library-level subprogram. * sem_prag.adb (Check_Test_Case): Stricter rules for test-case placement. (Analyze_Pragma): Change name "Normal" for "Nominal" in test-case component. * snames.ads-tmpl: Change name "Normal" for "Nominal" in test-case component. * gnat_rm.texi: Update doc for Test_Case pragma. 2011-08-29 Tristan Gingold * a-exexpr-gcc.adb (Unwind_Exception): Remove default value, made it convention C. (GCC_Exception_Access): New type. (Unwind_DeleteException): New imported procedure (Foreign_Exception): Import it. (GNAT_GCC_Exception): Simply have the occurrence inside. (To_GCC_Exception): New function. (To_GNAT_GCC_Exception): New function. (GNAT_GCC_Exception_Cleanup): New procedure.. (Propagate_GCC_Exception): New procedure. (Reraise_GCC_Exception): New procedure. (Setup_Current_Excep): New procedure. (CleanupUnwind_Handler): Change type of UW_Exception parameter. (Unwind_RaiseException): Ditto. (Unwind_ForcedUnwind): Ditto. (Remove): Removed. (Begin_Handler): Change type of parameter. (End_Handler): Ditto. Now delete the exception if still present. (Setup_Key): Removed. (Is_Setup_And_Not_Propagated): Removed. (Set_Setup_And_Not_Propagated): Ditto. (Clear_Setup_And_Not_Propagated): Ditto. (Save_Occurrence_And_Private): Ditto. (EID_For): Add 'not null' constraint on parameter. (Setup_Exception): Does nothing. (Propagate_Exception): Simplified. * exp_ch11.adb (Expand_N_Raise_Statement): In back-end exception model, re-raise is not expanded anymore. * s-except.ads (Foreign_Exception): New exception - placeholder for non Ada exceptions. * raise-gcc.c (__gnat_setup_current_excep): Declare (CXX_EXCEPTION_CLASS): Define (not yet used) (GNAT_EXCEPTION_CLASS): Define. (is_handled_by): Handle foreign exceptions. (PERSONALITY_FUNCTION): Call __gnat_setup_current_excep. 2011-08-29 Jose Ruiz * a-synbar.adb (Synchronous_Barrier): Some additional clarification. From-SVN: r178204 --- gcc/ada/raise-gcc.c | 87 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 52 insertions(+), 35 deletions(-) (limited to 'gcc/ada/raise-gcc.c') diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index fb0ec81..6dff0de 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -101,6 +101,7 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *); _Unwind_Reason_Code __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *); +extern void __gnat_setup_current_excep (_Unwind_Exception *); #ifdef IN_RTS /* For eh personality routine */ @@ -108,6 +109,10 @@ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *); #include "unwind-dw2-fde.h" #include "unwind-pe.h" +/* The known and handled exception classes. */ + +#define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL +#define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL /* -------------------------------------------------------------- -- The DB stuff below is there for debugging purposes only. -- @@ -853,39 +858,51 @@ extern Exception_Id EID_For (_GNAT_Exception * e); static int is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception) { - /* Pointer to the GNAT exception data corresponding to the propagated - occurrence. */ - _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception); - - /* Base matching rules: An exception data (id) matches itself, "when - all_others" matches anything and "when others" matches anything unless - explicitly stated otherwise in the propagated occurrence. */ - - bool is_handled = - choice == E - || choice == GNAT_ALL_OTHERS - || (choice == GNAT_OTHERS && Is_Handled_By_Others (E)); - - /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we - may have different exception data pointers that should match for the - same condition code, if both an export and an import have been - registered. The import code for both the choice and the propagated - occurrence are expected to have been masked off regarding severity - bits already (at registration time for the former and from within the - low level exception vector for the latter). */ + if (propagated_exception->common.exception_class == GNAT_EXCEPTION_CLASS) + { + /* Pointer to the GNAT exception data corresponding to the propagated + occurrence. */ + _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception); + + /* Base matching rules: An exception data (id) matches itself, "when + all_others" matches anything and "when others" matches anything + unless explicitly stated otherwise in the propagated occurrence. */ + + bool is_handled = + choice == E + || choice == GNAT_ALL_OTHERS + || (choice == GNAT_OTHERS && Is_Handled_By_Others (E)); + + /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we + may have different exception data pointers that should match for the + same condition code, if both an export and an import have been + registered. The import code for both the choice and the propagated + occurrence are expected to have been masked off regarding severity + bits already (at registration time for the former and from within the + low level exception vector for the latter). */ #ifdef VMS - #define Non_Ada_Error system__aux_dec__non_ada_error - extern struct Exception_Data Non_Ada_Error; - - is_handled |= - (Language_For (E) == 'V' - && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS - && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0 - && Import_Code_For (choice) == Import_Code_For (E)) - || choice == (_Unwind_Ptr)&Non_Ada_Error)); +# define Non_Ada_Error system__aux_dec__non_ada_error + extern struct Exception_Data Non_Ada_Error; + + is_handled |= + (Language_For (E) == 'V' + && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS + && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0 + && Import_Code_For (choice) == Import_Code_For (E)) + || choice == (_Unwind_Ptr)&Non_Ada_Error)); #endif - return is_handled; + return is_handled; + } + else + { +# define Foreign_Exception system__exceptions__foreign_exception; + extern struct Exception_Data Foreign_Exception; + + return choice == GNAT_ALL_OTHERS + || choice == GNAT_OTHERS + || choice == (_Unwind_Ptr)&Foreign_Exception; + } } /* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to @@ -1079,9 +1096,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, Condition Handling Facility. */ int uw_version = (int) version_arg; _Unwind_Action uw_phases = (_Unwind_Action) phases_arg; - - _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception; - region_descriptor region; action_descriptor action; @@ -1089,7 +1103,7 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, possible variation on VMS for IA64. */ if (uw_version != 1) { - #if defined (VMS) && defined (__IA64) +#if defined (VMS) && defined (__IA64) /* Assume we're called with sigargs/mechargs arguments if really unexpected bits are set in our first two formals. Redirect to the @@ -1103,7 +1117,7 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, if ((unsigned int)uw_version & version_unexpected_bits_mask && (unsigned int)uw_phases & phases_unexpected_bits_mask) return __gnat_handle_vms_condition (version_arg, phases_arg); - #endif +#endif return _URC_FATAL_PHASE1_ERROR; } @@ -1160,6 +1174,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, setup_to_install (uw_context, uw_exception, action.landing_pad, action.ttype_filter); + /* Write current exception, so that it can be retrieved from Ada. */ + __gnat_setup_current_excep (uw_exception); + return _URC_INSTALL_CONTEXT; } -- cgit v1.1