From 557e56be2648db13cd5d9876f702ba119ee9e7fd Mon Sep 17 00:00:00 2001 From: Pedro Alves Date: Wed, 18 Jul 2018 22:55:59 +0100 Subject: Eliminate most remaining cleanups under gdb/guile/ The main complication with the Guile code is that we have two types of exceptions to consider. GDB/C++ exceptions, and Guile/SJLJ exceptions. Code that is facing the Guile interpreter must not throw GDB exceptions, instead Scheme exceptions must be thrown. Also, because Guile exceptions are SJLJ based, Guile-facing code must not use local objects with dtors, unless wrapped in a scope with a TRY/CATCH, because the dtors won't otherwise be run when a Guile exceptions is thrown. This commit adds a new gdbscm_wrap wrapper function than encapsulates a pattern I noticed in many of the functions using GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS. The wrapper is written such that you can pass either a lambda to it, or a function plus a variable number of forwarded args. I used a lambda when its body would be reasonably short, and a separate function in the larger cases. This also convers a few functions that were using GDBSCM_HANDLE_GDB_EXCEPTION to use gdbscm_wrap too because they followed a similar pattern. A few cases of make_cleanup calls are replaced with explicit xfree calls. The make_cleanup/do_cleanups calls in those cases are pointless, because do_cleanups won't be called when a Scheme exception is thrown. We also have a couple cases of Guile-facing code using RAII-type objects to manage memory, but those are incorrect, exactly because their dtor won't be called if a Guile exception is thrown. gdb/ChangeLog: 2018-07-18 Pedro Alves * guile/guile-internal.h: Add comment about mixing GDB and Scheme exceptions. (GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS): Delete. (gdbscm_wrap): New. * guile/scm-frame.c (gdbscm_frame_read_register): Use xfree directly instead of a cleanup. * guile/scm-math.c (vlscm_unop_gdbthrow): New, factored out from ... (vlscm_unop): ... this. Reimplement using gdbscm_wrap. (vlscm_binop_gdbthrow): New, factored out from ... (vlscm_binop): ... this. Reimplement using gdbscm_wrap. (vlscm_rich_compare): Use gdbscm_wrap. * guile/scm-symbol.c (gdbscm_lookup_symbol): Use xfree directly instead of a cleanup. (gdbscm_lookup_global_symbol): Use xfree directly instead of a cleanup. * guile/scm-type.c (gdbscm_type_field, gdbscm_type_has_field_p): Use xfree directly instead of a cleanup. * guile/scm-value.c (gdbscm_make_value, gdbscm_make_lazy_value): Adjust to use gdbscm_wrap and scoped_value_mark. (gdbscm_value_optimized_out_p): Adjust to use gdbscm_wrap. (gdbscm_value_address, gdbscm_value_dereference) (gdbscm_value_referenced_value): Adjust to use gdbscm_wrap and scoped_value_mark. (gdbscm_value_dynamic_type): Use scoped_value_mark. (vlscm_do_cast, gdbscm_value_field): Adjust to use gdbscm_wrap and scoped_value_mark. (gdbscm_value_subscript, gdbscm_value_call): Adjust to use gdbscm_wrap and scoped_value_mark. (gdbscm_value_to_string): Use xfree directly instead of a cleanup. Move 'buffer' unique_ptr to TRY scope. (gdbscm_value_to_lazy_string): Use xfree directly instead of a cleanup. Move 'buffer' unique_ptr to TRY scope. Use scoped_value_mark. (gdbscm_value_fetch_lazy_x): Use gdbscm_wrap. (gdbscm_parse_and_eval): Adjust to use gdbscm_wrap and scoped_value_mark. (gdbscm_history_ref, gdbscm_history_append_x): Adjust to use gdbscm_wrap. --- gdb/guile/scm-math.c | 374 +++++++++++++++++++++++---------------------------- 1 file changed, 169 insertions(+), 205 deletions(-) (limited to 'gdb/guile/scm-math.c') diff --git a/gdb/guile/scm-math.c b/gdb/guile/scm-math.c index 5507dd7..74d5075 100644 --- a/gdb/guile/scm-math.c +++ b/gdb/guile/scm-math.c @@ -67,88 +67,77 @@ enum valscm_binary_opcode #define STRIP_REFERENCE(TYPE) \ ((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE)) -/* Returns a value object which is the result of applying the operation - specified by OPCODE to the given argument. - If there's an error a Scheme exception is thrown. */ +/* Helper for vlscm_unop. Contains all the code that may throw a GDB + exception. */ static SCM -vlscm_unop (enum valscm_unary_opcode opcode, SCM x, const char *func_name) +vlscm_unop_gdbthrow (enum valscm_unary_opcode opcode, SCM x, + const char *func_name) { struct gdbarch *gdbarch = get_current_arch (); const struct language_defn *language = current_language; - struct value *arg1; SCM result = SCM_BOOL_F; - struct value *res_val = NULL; - SCM except_scm; - struct cleanup *cleanups; - cleanups = make_cleanup_value_free_to_mark (value_mark ()); + scoped_value_mark free_values; - arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x, - &except_scm, gdbarch, language); + SCM except_scm; + value *arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x, + &except_scm, gdbarch, + language); if (arg1 == NULL) - { - do_cleanups (cleanups); - gdbscm_throw (except_scm); - } + return except_scm; - TRY - { - switch (opcode) - { - case VALSCM_NOT: - /* Alas gdb and guile use the opposite meaning for "logical not". */ - { - struct type *type = language_bool_type (language, gdbarch); - res_val - = value_from_longest (type, (LONGEST) value_logical_not (arg1)); - } - break; - case VALSCM_NEG: - res_val = value_neg (arg1); - break; - case VALSCM_NOP: - /* Seemingly a no-op, but if X was a Scheme value it is now - a object. */ - res_val = arg1; - break; - case VALSCM_ABS: - if (value_less (arg1, value_zero (value_type (arg1), not_lval))) - res_val = value_neg (arg1); - else - res_val = arg1; - break; - case VALSCM_LOGNOT: - res_val = value_complement (arg1); - break; - default: - gdb_assert_not_reached ("unsupported operation"); - } - } - CATCH (except, RETURN_MASK_ALL) + struct value *res_val = NULL; + + switch (opcode) { - GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups); + case VALSCM_NOT: + /* Alas gdb and guile use the opposite meaning for "logical + not". */ + { + struct type *type = language_bool_type (language, gdbarch); + res_val + = value_from_longest (type, + (LONGEST) value_logical_not (arg1)); + } + break; + case VALSCM_NEG: + res_val = value_neg (arg1); + break; + case VALSCM_NOP: + /* Seemingly a no-op, but if X was a Scheme value it is now a + object. */ + res_val = arg1; + break; + case VALSCM_ABS: + if (value_less (arg1, value_zero (value_type (arg1), not_lval))) + res_val = value_neg (arg1); + else + res_val = arg1; + break; + case VALSCM_LOGNOT: + res_val = value_complement (arg1); + break; + default: + gdb_assert_not_reached ("unsupported operation"); } - END_CATCH gdb_assert (res_val != NULL); - result = vlscm_scm_from_value (res_val); - - do_cleanups (cleanups); - - if (gdbscm_is_exception (result)) - gdbscm_throw (result); + return vlscm_scm_from_value (res_val); +} - return result; +static SCM +vlscm_unop (enum valscm_unary_opcode opcode, SCM x, const char *func_name) +{ + return gdbscm_wrap (vlscm_unop_gdbthrow, opcode, x, func_name); } -/* Returns a value object which is the result of applying the operation - specified by OPCODE to the given arguments. - If there's an error a Scheme exception is thrown. */ +/* Helper for vlscm_binop. Contains all the code that may throw a GDB + exception. */ static SCM -vlscm_binop (enum valscm_binary_opcode opcode, SCM x, SCM y, - const char *func_name) +vlscm_binop_gdbthrow (enum valscm_binary_opcode opcode, SCM x, SCM y, + const char *func_name) { struct gdbarch *gdbarch = get_current_arch (); const struct language_defn *language = current_language; @@ -156,129 +145,119 @@ vlscm_binop (enum valscm_binary_opcode opcode, SCM x, SCM y, SCM result = SCM_BOOL_F; struct value *res_val = NULL; SCM except_scm; - struct cleanup *cleanups; - cleanups = make_cleanup_value_free_to_mark (value_mark ()); + scoped_value_mark free_values; arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x, &except_scm, gdbarch, language); if (arg1 == NULL) - { - do_cleanups (cleanups); - gdbscm_throw (except_scm); - } + return except_scm; + arg2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y, &except_scm, gdbarch, language); if (arg2 == NULL) - { - do_cleanups (cleanups); - gdbscm_throw (except_scm); - } + return except_scm; - TRY + switch (opcode) { - switch (opcode) - { - case VALSCM_ADD: - { - struct type *ltype = value_type (arg1); - struct type *rtype = value_type (arg2); - - ltype = check_typedef (ltype); - ltype = STRIP_REFERENCE (ltype); - rtype = check_typedef (rtype); - rtype = STRIP_REFERENCE (rtype); - - if (TYPE_CODE (ltype) == TYPE_CODE_PTR - && is_integral_type (rtype)) - res_val = value_ptradd (arg1, value_as_long (arg2)); - else if (TYPE_CODE (rtype) == TYPE_CODE_PTR - && is_integral_type (ltype)) - res_val = value_ptradd (arg2, value_as_long (arg1)); - else - res_val = value_binop (arg1, arg2, BINOP_ADD); - } - break; - case VALSCM_SUB: + case VALSCM_ADD: + { + struct type *ltype = value_type (arg1); + struct type *rtype = value_type (arg2); + + ltype = check_typedef (ltype); + ltype = STRIP_REFERENCE (ltype); + rtype = check_typedef (rtype); + rtype = STRIP_REFERENCE (rtype); + + if (TYPE_CODE (ltype) == TYPE_CODE_PTR + && is_integral_type (rtype)) + res_val = value_ptradd (arg1, value_as_long (arg2)); + else if (TYPE_CODE (rtype) == TYPE_CODE_PTR + && is_integral_type (ltype)) + res_val = value_ptradd (arg2, value_as_long (arg1)); + else + res_val = value_binop (arg1, arg2, BINOP_ADD); + } + break; + case VALSCM_SUB: + { + struct type *ltype = value_type (arg1); + struct type *rtype = value_type (arg2); + + ltype = check_typedef (ltype); + ltype = STRIP_REFERENCE (ltype); + rtype = check_typedef (rtype); + rtype = STRIP_REFERENCE (rtype); + + if (TYPE_CODE (ltype) == TYPE_CODE_PTR + && TYPE_CODE (rtype) == TYPE_CODE_PTR) { - struct type *ltype = value_type (arg1); - struct type *rtype = value_type (arg2); - - ltype = check_typedef (ltype); - ltype = STRIP_REFERENCE (ltype); - rtype = check_typedef (rtype); - rtype = STRIP_REFERENCE (rtype); - - if (TYPE_CODE (ltype) == TYPE_CODE_PTR - && TYPE_CODE (rtype) == TYPE_CODE_PTR) - { - /* A ptrdiff_t for the target would be preferable here. */ - res_val - = value_from_longest (builtin_type (gdbarch)->builtin_long, - value_ptrdiff (arg1, arg2)); - } - else if (TYPE_CODE (ltype) == TYPE_CODE_PTR - && is_integral_type (rtype)) - res_val = value_ptradd (arg1, - value_as_long (arg2)); - else - res_val = value_binop (arg1, arg2, BINOP_SUB); + /* A ptrdiff_t for the target would be preferable here. */ + res_val + = value_from_longest (builtin_type (gdbarch)->builtin_long, + value_ptrdiff (arg1, arg2)); } - break; - case VALSCM_MUL: - res_val = value_binop (arg1, arg2, BINOP_MUL); - break; - case VALSCM_DIV: - res_val = value_binop (arg1, arg2, BINOP_DIV); - break; - case VALSCM_REM: - res_val = value_binop (arg1, arg2, BINOP_REM); - break; - case VALSCM_MOD: - res_val = value_binop (arg1, arg2, BINOP_MOD); - break; - case VALSCM_POW: - res_val = value_binop (arg1, arg2, BINOP_EXP); - break; - case VALSCM_LSH: - res_val = value_binop (arg1, arg2, BINOP_LSH); - break; - case VALSCM_RSH: - res_val = value_binop (arg1, arg2, BINOP_RSH); - break; - case VALSCM_MIN: - res_val = value_binop (arg1, arg2, BINOP_MIN); - break; - case VALSCM_MAX: - res_val = value_binop (arg1, arg2, BINOP_MAX); - break; - case VALSCM_BITAND: - res_val = value_binop (arg1, arg2, BINOP_BITWISE_AND); - break; - case VALSCM_BITOR: - res_val = value_binop (arg1, arg2, BINOP_BITWISE_IOR); - break; - case VALSCM_BITXOR: - res_val = value_binop (arg1, arg2, BINOP_BITWISE_XOR); - break; - default: - gdb_assert_not_reached ("unsupported operation"); - } - } - CATCH (except, RETURN_MASK_ALL) - { - GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups); + else if (TYPE_CODE (ltype) == TYPE_CODE_PTR + && is_integral_type (rtype)) + res_val = value_ptradd (arg1, - value_as_long (arg2)); + else + res_val = value_binop (arg1, arg2, BINOP_SUB); + } + break; + case VALSCM_MUL: + res_val = value_binop (arg1, arg2, BINOP_MUL); + break; + case VALSCM_DIV: + res_val = value_binop (arg1, arg2, BINOP_DIV); + break; + case VALSCM_REM: + res_val = value_binop (arg1, arg2, BINOP_REM); + break; + case VALSCM_MOD: + res_val = value_binop (arg1, arg2, BINOP_MOD); + break; + case VALSCM_POW: + res_val = value_binop (arg1, arg2, BINOP_EXP); + break; + case VALSCM_LSH: + res_val = value_binop (arg1, arg2, BINOP_LSH); + break; + case VALSCM_RSH: + res_val = value_binop (arg1, arg2, BINOP_RSH); + break; + case VALSCM_MIN: + res_val = value_binop (arg1, arg2, BINOP_MIN); + break; + case VALSCM_MAX: + res_val = value_binop (arg1, arg2, BINOP_MAX); + break; + case VALSCM_BITAND: + res_val = value_binop (arg1, arg2, BINOP_BITWISE_AND); + break; + case VALSCM_BITOR: + res_val = value_binop (arg1, arg2, BINOP_BITWISE_IOR); + break; + case VALSCM_BITXOR: + res_val = value_binop (arg1, arg2, BINOP_BITWISE_XOR); + break; + default: + gdb_assert_not_reached ("unsupported operation"); } - END_CATCH gdb_assert (res_val != NULL); - result = vlscm_scm_from_value (res_val); - - do_cleanups (cleanups); + return vlscm_scm_from_value (res_val); +} - if (gdbscm_is_exception (result)) - gdbscm_throw (result); +/* Returns a value object which is the result of applying the operation + specified by OPCODE to the given arguments. + If there's an error a Scheme exception is thrown. */ - return result; +static SCM +vlscm_binop (enum valscm_binary_opcode opcode, SCM x, SCM y, + const char *func_name) +{ + return gdbscm_wrap (vlscm_binop_gdbthrow, opcode, x, y, func_name); } /* (value-add x y) -> */ @@ -439,33 +418,27 @@ gdbscm_value_logxor (SCM x, SCM y) static SCM vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name) { - struct gdbarch *gdbarch = get_current_arch (); - const struct language_defn *language = current_language; - struct value *v1, *v2; - int result = 0; - SCM except_scm; - struct cleanup *cleanups; - struct gdb_exception except = exception_none; + return gdbscm_wrap ([=] + { + struct gdbarch *gdbarch = get_current_arch (); + const struct language_defn *language = current_language; + SCM except_scm; - cleanups = make_cleanup_value_free_to_mark (value_mark ()); + scoped_value_mark free_values; - v1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x, - &except_scm, gdbarch, language); - if (v1 == NULL) - { - do_cleanups (cleanups); - gdbscm_throw (except_scm); - } - v2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y, - &except_scm, gdbarch, language); - if (v2 == NULL) - { - do_cleanups (cleanups); - gdbscm_throw (except_scm); - } + value *v1 + = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x, + &except_scm, gdbarch, language); + if (v1 == NULL) + return except_scm; - TRY - { + value *v2 + = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y, + &except_scm, gdbarch, language); + if (v2 == NULL) + return except_scm; + + int result; switch (op) { case BINOP_LESS: @@ -489,18 +462,9 @@ vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name) break; default: gdb_assert_not_reached ("invalid comparison"); - } - } - CATCH (ex, RETURN_MASK_ALL) - { - except = ex; - } - END_CATCH - - do_cleanups (cleanups); - GDBSCM_HANDLE_GDB_EXCEPTION (except); - - return scm_from_bool (result); + } + return scm_from_bool (result); + }); } /* (value=? x y) -> boolean -- cgit v1.1