mirror of
https://github.com/espressif/binutils-gdb.git
synced 2025-06-21 02:24:17 +08:00
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 <palves@redhat.com> * 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.
This commit is contained in:
@ -1,3 +1,44 @@
|
|||||||
|
2018-07-18 Pedro Alves <palves@redhat.com>
|
||||||
|
|
||||||
|
* 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.
|
||||||
|
|
||||||
2018-07-18 Tom de Vries <tdevries@suse.de>
|
2018-07-18 Tom de Vries <tdevries@suse.de>
|
||||||
|
|
||||||
* findvar.c (default_read_var_value): Also resolve dynamic type for
|
* findvar.c (default_read_var_value): Also resolve dynamic type for
|
||||||
|
@ -639,8 +639,18 @@ extern void gdbscm_initialize_symtabs (void);
|
|||||||
extern void gdbscm_initialize_types (void);
|
extern void gdbscm_initialize_types (void);
|
||||||
extern void gdbscm_initialize_values (void);
|
extern void gdbscm_initialize_values (void);
|
||||||
|
|
||||||
/* Use these after a TRY_CATCH to throw the appropriate Scheme exception
|
|
||||||
if a GDB error occurred. */
|
/* A 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. */
|
||||||
|
|
||||||
|
/* Use this after a TRY/CATCH to throw the appropriate Scheme
|
||||||
|
exception if a GDB error occurred. */
|
||||||
|
|
||||||
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception) \
|
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception) \
|
||||||
do { \
|
do { \
|
||||||
@ -651,16 +661,35 @@ extern void gdbscm_initialize_values (void);
|
|||||||
} \
|
} \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
/* If cleanups are establish outside the TRY_CATCH block, use this version. */
|
/* Use this to wrap a callable to throw the appropriate Scheme
|
||||||
|
exception if the callable throws a GDB error. ARGS are forwarded
|
||||||
|
to FUNC. Returns the result of FUNC, unless FUNC returns a Scheme
|
||||||
|
exception, in which case that exception is thrown. Note that while
|
||||||
|
the callable is free to use objects of types with destructors,
|
||||||
|
because GDB errors are C++ exceptions, the caller of gdbscm_wrap
|
||||||
|
must not use such objects, because their destructors would not be
|
||||||
|
called when a Scheme exception is thrown. */
|
||||||
|
|
||||||
#define GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS(exception, cleanups) \
|
template<typename Function, typename... Args>
|
||||||
do { \
|
SCM
|
||||||
if (exception.reason < 0) \
|
gdbscm_wrap (Function &&func, Args... args)
|
||||||
{ \
|
{
|
||||||
do_cleanups (cleanups); \
|
SCM result = SCM_BOOL_F;
|
||||||
gdbscm_throw_gdb_exception (exception); \
|
|
||||||
/*NOTREACHED */ \
|
TRY
|
||||||
} \
|
{
|
||||||
} while (0)
|
result = func (std::forward<Args> (args)...);
|
||||||
|
}
|
||||||
|
CATCH (except, RETURN_MASK_ALL)
|
||||||
|
{
|
||||||
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||||
|
}
|
||||||
|
END_CATCH
|
||||||
|
|
||||||
|
if (gdbscm_is_exception (result))
|
||||||
|
gdbscm_throw (result);
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
#endif /* GDB_GUILE_INTERNAL_H */
|
#endif /* GDB_GUILE_INTERNAL_H */
|
||||||
|
@ -783,13 +783,13 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
|
|||||||
char *register_str;
|
char *register_str;
|
||||||
struct value *value = NULL;
|
struct value *value = NULL;
|
||||||
struct frame_info *frame = NULL;
|
struct frame_info *frame = NULL;
|
||||||
struct cleanup *cleanup;
|
|
||||||
frame_smob *f_smob;
|
frame_smob *f_smob;
|
||||||
|
|
||||||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
|
||||||
register_scm, ®ister_str);
|
register_scm, ®ister_str);
|
||||||
cleanup = make_cleanup (xfree, register_str);
|
|
||||||
|
struct gdb_exception except = exception_none;
|
||||||
|
|
||||||
TRY
|
TRY
|
||||||
{
|
{
|
||||||
@ -805,13 +805,14 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
|
|||||||
value = value_of_register (regnum, frame);
|
value = value_of_register (regnum, frame);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
CATCH (ex, RETURN_MASK_ALL)
|
||||||
{
|
{
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
except = ex;
|
||||||
}
|
}
|
||||||
END_CATCH
|
END_CATCH
|
||||||
|
|
||||||
do_cleanups (cleanup);
|
xfree (register_str);
|
||||||
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||||
|
|
||||||
if (frame == NULL)
|
if (frame == NULL)
|
||||||
{
|
{
|
||||||
|
@ -67,79 +67,186 @@ enum valscm_binary_opcode
|
|||||||
#define STRIP_REFERENCE(TYPE) \
|
#define STRIP_REFERENCE(TYPE) \
|
||||||
((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE))
|
((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE))
|
||||||
|
|
||||||
/* Returns a value object which is the result of applying the operation
|
/* Helper for vlscm_unop. Contains all the code that may throw a GDB
|
||||||
specified by OPCODE to the given argument.
|
exception. */
|
||||||
If there's an error a Scheme exception is thrown. */
|
|
||||||
|
static SCM
|
||||||
|
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;
|
||||||
|
SCM result = SCM_BOOL_F;
|
||||||
|
|
||||||
|
scoped_value_mark free_values;
|
||||||
|
|
||||||
|
SCM except_scm;
|
||||||
|
value *arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
|
||||||
|
&except_scm, gdbarch,
|
||||||
|
language);
|
||||||
|
if (arg1 == NULL)
|
||||||
|
return except_scm;
|
||||||
|
|
||||||
|
struct value *res_val = NULL;
|
||||||
|
|
||||||
|
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
|
||||||
|
<gdb:value> 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");
|
||||||
|
}
|
||||||
|
|
||||||
|
gdb_assert (res_val != NULL);
|
||||||
|
return vlscm_scm_from_value (res_val);
|
||||||
|
}
|
||||||
|
|
||||||
static SCM
|
static SCM
|
||||||
vlscm_unop (enum valscm_unary_opcode opcode, SCM x, const char *func_name)
|
vlscm_unop (enum valscm_unary_opcode opcode, SCM x, const char *func_name)
|
||||||
|
{
|
||||||
|
return gdbscm_wrap (vlscm_unop_gdbthrow, opcode, x, func_name);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Helper for vlscm_binop. Contains all the code that may throw a GDB
|
||||||
|
exception. */
|
||||||
|
|
||||||
|
static SCM
|
||||||
|
vlscm_binop_gdbthrow (enum valscm_binary_opcode opcode, SCM x, SCM y,
|
||||||
|
const char *func_name)
|
||||||
{
|
{
|
||||||
struct gdbarch *gdbarch = get_current_arch ();
|
struct gdbarch *gdbarch = get_current_arch ();
|
||||||
const struct language_defn *language = current_language;
|
const struct language_defn *language = current_language;
|
||||||
struct value *arg1;
|
struct value *arg1, *arg2;
|
||||||
SCM result = SCM_BOOL_F;
|
SCM result = SCM_BOOL_F;
|
||||||
struct value *res_val = NULL;
|
struct value *res_val = NULL;
|
||||||
SCM except_scm;
|
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,
|
arg1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
|
||||||
&except_scm, gdbarch, language);
|
&except_scm, gdbarch, language);
|
||||||
if (arg1 == NULL)
|
if (arg1 == NULL)
|
||||||
{
|
return except_scm;
|
||||||
do_cleanups (cleanups);
|
|
||||||
gdbscm_throw (except_scm);
|
|
||||||
}
|
|
||||||
|
|
||||||
TRY
|
arg2 = vlscm_convert_value_from_scheme (func_name, SCM_ARG2, y,
|
||||||
|
&except_scm, gdbarch, language);
|
||||||
|
if (arg2 == NULL)
|
||||||
|
return except_scm;
|
||||||
|
|
||||||
|
switch (opcode)
|
||||||
{
|
{
|
||||||
switch (opcode)
|
case VALSCM_ADD:
|
||||||
{
|
{
|
||||||
case VALSCM_NOT:
|
struct type *ltype = value_type (arg1);
|
||||||
/* Alas gdb and guile use the opposite meaning for "logical not". */
|
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 *type = language_bool_type (language, gdbarch);
|
/* A ptrdiff_t for the target would be preferable here. */
|
||||||
res_val
|
res_val
|
||||||
= value_from_longest (type, (LONGEST) value_logical_not (arg1));
|
= value_from_longest (builtin_type (gdbarch)->builtin_long,
|
||||||
|
value_ptrdiff (arg1, arg2));
|
||||||
}
|
}
|
||||||
break;
|
else if (TYPE_CODE (ltype) == TYPE_CODE_PTR
|
||||||
case VALSCM_NEG:
|
&& is_integral_type (rtype))
|
||||||
res_val = value_neg (arg1);
|
res_val = value_ptradd (arg1, - value_as_long (arg2));
|
||||||
break;
|
else
|
||||||
case VALSCM_NOP:
|
res_val = value_binop (arg1, arg2, BINOP_SUB);
|
||||||
/* Seemingly a no-op, but if X was a Scheme value it is now
|
}
|
||||||
a <gdb:value> object. */
|
break;
|
||||||
res_val = arg1;
|
case VALSCM_MUL:
|
||||||
break;
|
res_val = value_binop (arg1, arg2, BINOP_MUL);
|
||||||
case VALSCM_ABS:
|
break;
|
||||||
if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
|
case VALSCM_DIV:
|
||||||
res_val = value_neg (arg1);
|
res_val = value_binop (arg1, arg2, BINOP_DIV);
|
||||||
else
|
break;
|
||||||
res_val = arg1;
|
case VALSCM_REM:
|
||||||
break;
|
res_val = value_binop (arg1, arg2, BINOP_REM);
|
||||||
case VALSCM_LOGNOT:
|
break;
|
||||||
res_val = value_complement (arg1);
|
case VALSCM_MOD:
|
||||||
break;
|
res_val = value_binop (arg1, arg2, BINOP_MOD);
|
||||||
default:
|
break;
|
||||||
gdb_assert_not_reached ("unsupported operation");
|
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);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
gdb_assert (res_val != NULL);
|
gdb_assert (res_val != NULL);
|
||||||
result = vlscm_scm_from_value (res_val);
|
return vlscm_scm_from_value (res_val);
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
|
||||||
gdbscm_throw (result);
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Returns a value object which is the result of applying the operation
|
/* Returns a value object which is the result of applying the operation
|
||||||
@ -150,135 +257,7 @@ static SCM
|
|||||||
vlscm_binop (enum valscm_binary_opcode opcode, SCM x, SCM y,
|
vlscm_binop (enum valscm_binary_opcode opcode, SCM x, SCM y,
|
||||||
const char *func_name)
|
const char *func_name)
|
||||||
{
|
{
|
||||||
struct gdbarch *gdbarch = get_current_arch ();
|
return gdbscm_wrap (vlscm_binop_gdbthrow, opcode, x, y, func_name);
|
||||||
const struct language_defn *language = current_language;
|
|
||||||
struct value *arg1, *arg2;
|
|
||||||
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 ());
|
|
||||||
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
|
||||||
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:
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
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 result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-add x y) -> <gdb:value> */
|
/* (value-add x y) -> <gdb:value> */
|
||||||
@ -439,33 +418,27 @@ gdbscm_value_logxor (SCM x, SCM y)
|
|||||||
static SCM
|
static SCM
|
||||||
vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name)
|
vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name)
|
||||||
{
|
{
|
||||||
struct gdbarch *gdbarch = get_current_arch ();
|
return gdbscm_wrap ([=]
|
||||||
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;
|
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
|
||||||
|
|
||||||
v1 = vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
|
|
||||||
&except_scm, gdbarch, language);
|
|
||||||
if (v1 == NULL)
|
|
||||||
{
|
{
|
||||||
do_cleanups (cleanups);
|
struct gdbarch *gdbarch = get_current_arch ();
|
||||||
gdbscm_throw (except_scm);
|
const struct language_defn *language = current_language;
|
||||||
}
|
SCM 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);
|
|
||||||
}
|
|
||||||
|
|
||||||
TRY
|
scoped_value_mark free_values;
|
||||||
{
|
|
||||||
|
value *v1
|
||||||
|
= vlscm_convert_value_from_scheme (func_name, SCM_ARG1, x,
|
||||||
|
&except_scm, gdbarch, language);
|
||||||
|
if (v1 == NULL)
|
||||||
|
return except_scm;
|
||||||
|
|
||||||
|
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)
|
switch (op)
|
||||||
{
|
{
|
||||||
case BINOP_LESS:
|
case BINOP_LESS:
|
||||||
@ -489,18 +462,9 @@ vlscm_rich_compare (int op, SCM x, SCM y, const char *func_name)
|
|||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
gdb_assert_not_reached ("invalid <gdb:value> comparison");
|
gdb_assert_not_reached ("invalid <gdb:value> comparison");
|
||||||
}
|
}
|
||||||
}
|
return scm_from_bool (result);
|
||||||
CATCH (ex, RETURN_MASK_ALL)
|
});
|
||||||
{
|
|
||||||
except = ex;
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
||||||
|
|
||||||
return scm_from_bool (result);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value=? x y) -> boolean
|
/* (value=? x y) -> boolean
|
||||||
|
@ -582,16 +582,12 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
|
|||||||
int block_arg_pos = -1, domain_arg_pos = -1;
|
int block_arg_pos = -1, domain_arg_pos = -1;
|
||||||
struct field_of_this_result is_a_field_of_this;
|
struct field_of_this_result is_a_field_of_this;
|
||||||
struct symbol *symbol = NULL;
|
struct symbol *symbol = NULL;
|
||||||
struct cleanup *cleanups;
|
|
||||||
struct gdb_exception except = exception_none;
|
|
||||||
|
|
||||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
|
||||||
name_scm, &name, rest,
|
name_scm, &name, rest,
|
||||||
&block_arg_pos, &block_scm,
|
&block_arg_pos, &block_scm,
|
||||||
&domain_arg_pos, &domain);
|
&domain_arg_pos, &domain);
|
||||||
|
|
||||||
cleanups = make_cleanup (xfree, name);
|
|
||||||
|
|
||||||
if (block_arg_pos >= 0)
|
if (block_arg_pos >= 0)
|
||||||
{
|
{
|
||||||
SCM except_scm;
|
SCM except_scm;
|
||||||
@ -600,7 +596,7 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
|
|||||||
&except_scm);
|
&except_scm);
|
||||||
if (block == NULL)
|
if (block == NULL)
|
||||||
{
|
{
|
||||||
do_cleanups (cleanups);
|
xfree (name);
|
||||||
gdbscm_throw (except_scm);
|
gdbscm_throw (except_scm);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -615,11 +611,13 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
|
|||||||
}
|
}
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
CATCH (except, RETURN_MASK_ALL)
|
||||||
{
|
{
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
xfree (name);
|
||||||
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||||
}
|
}
|
||||||
END_CATCH
|
END_CATCH
|
||||||
}
|
}
|
||||||
|
|
||||||
|
struct gdb_exception except = exception_none;
|
||||||
TRY
|
TRY
|
||||||
{
|
{
|
||||||
symbol = lookup_symbol (name, block, (domain_enum) domain,
|
symbol = lookup_symbol (name, block, (domain_enum) domain,
|
||||||
@ -631,7 +629,7 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
|
|||||||
}
|
}
|
||||||
END_CATCH
|
END_CATCH
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
xfree (name);
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||||
|
|
||||||
if (symbol == NULL)
|
if (symbol == NULL)
|
||||||
@ -652,15 +650,12 @@ gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
|
|||||||
int domain_arg_pos = -1;
|
int domain_arg_pos = -1;
|
||||||
int domain = VAR_DOMAIN;
|
int domain = VAR_DOMAIN;
|
||||||
struct symbol *symbol = NULL;
|
struct symbol *symbol = NULL;
|
||||||
struct cleanup *cleanups;
|
|
||||||
struct gdb_exception except = exception_none;
|
struct gdb_exception except = exception_none;
|
||||||
|
|
||||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
|
||||||
name_scm, &name, rest,
|
name_scm, &name, rest,
|
||||||
&domain_arg_pos, &domain);
|
&domain_arg_pos, &domain);
|
||||||
|
|
||||||
cleanups = make_cleanup (xfree, name);
|
|
||||||
|
|
||||||
TRY
|
TRY
|
||||||
{
|
{
|
||||||
symbol = lookup_global_symbol (name, NULL, (domain_enum) domain).symbol;
|
symbol = lookup_global_symbol (name, NULL, (domain_enum) domain).symbol;
|
||||||
@ -671,7 +666,7 @@ gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
|
|||||||
}
|
}
|
||||||
END_CATCH
|
END_CATCH
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
xfree (name);
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||||
|
|
||||||
if (symbol == NULL)
|
if (symbol == NULL)
|
||||||
|
@ -977,7 +977,6 @@ gdbscm_type_field (SCM self, SCM field_scm)
|
|||||||
struct type *type = t_smob->type;
|
struct type *type = t_smob->type;
|
||||||
char *field;
|
char *field;
|
||||||
int i;
|
int i;
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
||||||
_("string"));
|
_("string"));
|
||||||
@ -992,7 +991,6 @@ gdbscm_type_field (SCM self, SCM field_scm)
|
|||||||
_(not_composite_error));
|
_(not_composite_error));
|
||||||
|
|
||||||
field = gdbscm_scm_to_c_string (field_scm);
|
field = gdbscm_scm_to_c_string (field_scm);
|
||||||
cleanups = make_cleanup (xfree, field);
|
|
||||||
|
|
||||||
for (i = 0; i < TYPE_NFIELDS (type); i++)
|
for (i = 0; i < TYPE_NFIELDS (type); i++)
|
||||||
{
|
{
|
||||||
@ -1000,12 +998,12 @@ gdbscm_type_field (SCM self, SCM field_scm)
|
|||||||
|
|
||||||
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
|
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
|
||||||
{
|
{
|
||||||
do_cleanups (cleanups);
|
xfree (field);
|
||||||
return tyscm_make_field_smob (self, i);
|
return tyscm_make_field_smob (self, i);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
xfree (field);
|
||||||
|
|
||||||
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm,
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm,
|
||||||
_("Unknown field"));
|
_("Unknown field"));
|
||||||
@ -1022,7 +1020,6 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
|
|||||||
struct type *type = t_smob->type;
|
struct type *type = t_smob->type;
|
||||||
char *field;
|
char *field;
|
||||||
int i;
|
int i;
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
||||||
_("string"));
|
_("string"));
|
||||||
@ -1037,7 +1034,6 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
|
|||||||
_(not_composite_error));
|
_(not_composite_error));
|
||||||
|
|
||||||
field = gdbscm_scm_to_c_string (field_scm);
|
field = gdbscm_scm_to_c_string (field_scm);
|
||||||
cleanups = make_cleanup (xfree, field);
|
|
||||||
|
|
||||||
for (i = 0; i < TYPE_NFIELDS (type); i++)
|
for (i = 0; i < TYPE_NFIELDS (type); i++)
|
||||||
{
|
{
|
||||||
@ -1045,12 +1041,12 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
|
|||||||
|
|
||||||
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
|
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
|
||||||
{
|
{
|
||||||
do_cleanups (cleanups);
|
xfree (field);
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
xfree (field);
|
||||||
|
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
}
|
}
|
||||||
|
@ -303,46 +303,38 @@ vlscm_scm_to_value (SCM v_scm)
|
|||||||
static SCM
|
static SCM
|
||||||
gdbscm_make_value (SCM x, SCM rest)
|
gdbscm_make_value (SCM x, SCM rest)
|
||||||
{
|
{
|
||||||
struct gdbarch *gdbarch = get_current_arch ();
|
|
||||||
const struct language_defn *language = current_language;
|
|
||||||
const SCM keywords[] = { type_keyword, SCM_BOOL_F };
|
const SCM keywords[] = { type_keyword, SCM_BOOL_F };
|
||||||
|
|
||||||
int type_arg_pos = -1;
|
int type_arg_pos = -1;
|
||||||
SCM type_scm = SCM_UNDEFINED;
|
SCM type_scm = SCM_UNDEFINED;
|
||||||
SCM except_scm, result;
|
|
||||||
type_smob *t_smob;
|
|
||||||
struct type *type = NULL;
|
|
||||||
struct value *value;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest,
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest,
|
||||||
&type_arg_pos, &type_scm);
|
&type_arg_pos, &type_scm);
|
||||||
|
|
||||||
|
struct type *type = NULL;
|
||||||
if (type_arg_pos > 0)
|
if (type_arg_pos > 0)
|
||||||
{
|
{
|
||||||
t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, type_arg_pos,
|
type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
|
||||||
FUNC_NAME);
|
type_arg_pos,
|
||||||
|
FUNC_NAME);
|
||||||
type = tyscm_type_smob_type (t_smob);
|
type = tyscm_type_smob_type (t_smob);
|
||||||
}
|
}
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
|
{
|
||||||
|
scoped_value_mark free_values;
|
||||||
|
|
||||||
value = vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
|
SCM except_scm;
|
||||||
|
struct value *value
|
||||||
|
= vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
|
||||||
type_arg_pos, type_scm, type,
|
type_arg_pos, type_scm, type,
|
||||||
&except_scm,
|
&except_scm,
|
||||||
gdbarch, language);
|
get_current_arch (),
|
||||||
if (value == NULL)
|
current_language);
|
||||||
{
|
if (value == NULL)
|
||||||
do_cleanups (cleanups);
|
return except_scm;
|
||||||
gdbscm_throw (except_scm);
|
|
||||||
}
|
|
||||||
|
|
||||||
result = vlscm_scm_from_value (value);
|
return vlscm_scm_from_value (value);
|
||||||
|
});
|
||||||
do_cleanups (cleanups);
|
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
|
||||||
gdbscm_throw (result);
|
|
||||||
return result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (make-lazy-value <gdb:type> address) -> <gdb:value> */
|
/* (make-lazy-value <gdb:type> address) -> <gdb:value> */
|
||||||
@ -350,40 +342,22 @@ gdbscm_make_value (SCM x, SCM rest)
|
|||||||
static SCM
|
static SCM
|
||||||
gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
|
gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
|
||||||
{
|
{
|
||||||
type_smob *t_smob;
|
type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
|
||||||
struct type *type;
|
SCM_ARG1, FUNC_NAME);
|
||||||
|
struct type *type = tyscm_type_smob_type (t_smob);
|
||||||
|
|
||||||
ULONGEST address;
|
ULONGEST address;
|
||||||
struct value *value = NULL;
|
|
||||||
SCM result;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG1, FUNC_NAME);
|
|
||||||
type = tyscm_type_smob_type (t_smob);
|
|
||||||
|
|
||||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
|
||||||
address_scm, &address);
|
address_scm, &address);
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
|
|
||||||
/* There's no (current) need to wrap this in a TRY_CATCH, but for consistency
|
|
||||||
and future-proofing we do. */
|
|
||||||
TRY
|
|
||||||
{
|
|
||||||
value = value_from_contents_and_address (type, NULL, address);
|
|
||||||
}
|
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
{
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
scoped_value_mark free_values;
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
result = vlscm_scm_from_value (value);
|
struct value *value = value_from_contents_and_address (type, NULL,
|
||||||
|
address);
|
||||||
do_cleanups (cleanups);
|
return vlscm_scm_from_value (value);
|
||||||
|
});
|
||||||
if (gdbscm_is_exception (result))
|
|
||||||
gdbscm_throw (result);
|
|
||||||
return result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-optimized-out? <gdb:value>) -> boolean */
|
/* (value-optimized-out? <gdb:value>) -> boolean */
|
||||||
@ -393,20 +367,11 @@ gdbscm_value_optimized_out_p (SCM self)
|
|||||||
{
|
{
|
||||||
value_smob *v_smob
|
value_smob *v_smob
|
||||||
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
struct value *value = v_smob->value;
|
|
||||||
int opt = 0;
|
|
||||||
|
|
||||||
TRY
|
return gdbscm_wrap ([=]
|
||||||
{
|
{
|
||||||
opt = value_optimized_out (value);
|
return scm_from_bool (value_optimized_out (v_smob->value));
|
||||||
}
|
});
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
return scm_from_bool (opt);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-address <gdb:value>) -> integer
|
/* (value-address <gdb:value>) -> integer
|
||||||
@ -419,30 +384,31 @@ gdbscm_value_address (SCM self)
|
|||||||
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
struct value *value = v_smob->value;
|
struct value *value = v_smob->value;
|
||||||
|
|
||||||
if (SCM_UNBNDP (v_smob->address))
|
return gdbscm_wrap ([=]
|
||||||
{
|
{
|
||||||
struct cleanup *cleanup
|
if (SCM_UNBNDP (v_smob->address))
|
||||||
= make_cleanup_value_free_to_mark (value_mark ());
|
|
||||||
SCM address = SCM_BOOL_F;
|
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
{
|
||||||
address = vlscm_scm_from_value (value_addr (value));
|
scoped_value_mark free_values;
|
||||||
|
|
||||||
|
SCM address = SCM_BOOL_F;
|
||||||
|
|
||||||
|
TRY
|
||||||
|
{
|
||||||
|
address = vlscm_scm_from_value (value_addr (value));
|
||||||
|
}
|
||||||
|
CATCH (except, RETURN_MASK_ALL)
|
||||||
|
{
|
||||||
|
}
|
||||||
|
END_CATCH
|
||||||
|
|
||||||
|
if (gdbscm_is_exception (address))
|
||||||
|
return address;
|
||||||
|
|
||||||
|
v_smob->address = address;
|
||||||
}
|
}
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
do_cleanups (cleanup);
|
return v_smob->address;
|
||||||
|
});
|
||||||
if (gdbscm_is_exception (address))
|
|
||||||
gdbscm_throw (address);
|
|
||||||
|
|
||||||
v_smob->address = address;
|
|
||||||
}
|
|
||||||
|
|
||||||
return v_smob->address;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-dereference <gdb:value>) -> <gdb:value>
|
/* (value-dereference <gdb:value>) -> <gdb:value>
|
||||||
@ -453,31 +419,14 @@ gdbscm_value_dereference (SCM self)
|
|||||||
{
|
{
|
||||||
value_smob *v_smob
|
value_smob *v_smob
|
||||||
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
struct value *value = v_smob->value;
|
|
||||||
SCM result;
|
|
||||||
struct value *res_val = NULL;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
{
|
||||||
res_val = value_ind (value);
|
scoped_value_mark free_values;
|
||||||
}
|
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
result = vlscm_scm_from_value (res_val);
|
struct value *res_val = value_ind (v_smob->value);
|
||||||
|
return vlscm_scm_from_value (res_val);
|
||||||
do_cleanups (cleanups);
|
});
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
|
||||||
gdbscm_throw (result);
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-referenced-value <gdb:value>) -> <gdb:value>
|
/* (value-referenced-value <gdb:value>) -> <gdb:value>
|
||||||
@ -495,14 +444,13 @@ gdbscm_value_referenced_value (SCM self)
|
|||||||
value_smob *v_smob
|
value_smob *v_smob
|
||||||
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
struct value *value = v_smob->value;
|
struct value *value = v_smob->value;
|
||||||
SCM result;
|
|
||||||
struct value *res_val = NULL;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
{
|
||||||
|
scoped_value_mark free_values;
|
||||||
|
|
||||||
|
struct value *res_val;
|
||||||
|
|
||||||
switch (TYPE_CODE (check_typedef (value_type (value))))
|
switch (TYPE_CODE (check_typedef (value_type (value))))
|
||||||
{
|
{
|
||||||
case TYPE_CODE_PTR:
|
case TYPE_CODE_PTR:
|
||||||
@ -515,21 +463,9 @@ gdbscm_value_referenced_value (SCM self)
|
|||||||
error (_("Trying to get the referenced value from a value which is"
|
error (_("Trying to get the referenced value from a value which is"
|
||||||
" neither a pointer nor a reference"));
|
" neither a pointer nor a reference"));
|
||||||
}
|
}
|
||||||
}
|
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
result = vlscm_scm_from_value (res_val);
|
return vlscm_scm_from_value (res_val);
|
||||||
|
});
|
||||||
do_cleanups (cleanups);
|
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
|
||||||
gdbscm_throw (result);
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-type <gdb:value>) -> <gdb:type> */
|
/* (value-type <gdb:value>) -> <gdb:type> */
|
||||||
@ -562,8 +498,7 @@ gdbscm_value_dynamic_type (SCM self)
|
|||||||
|
|
||||||
TRY
|
TRY
|
||||||
{
|
{
|
||||||
struct cleanup *cleanup
|
scoped_value_mark free_values;
|
||||||
= make_cleanup_value_free_to_mark (value_mark ());
|
|
||||||
|
|
||||||
type = value_type (value);
|
type = value_type (value);
|
||||||
type = check_typedef (type);
|
type = check_typedef (type);
|
||||||
@ -596,8 +531,6 @@ gdbscm_value_dynamic_type (SCM self)
|
|||||||
/* Re-use object's static type. */
|
/* Re-use object's static type. */
|
||||||
type = NULL;
|
type = NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
do_cleanups (cleanup);
|
|
||||||
}
|
}
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
CATCH (except, RETURN_MASK_ALL)
|
||||||
{
|
{
|
||||||
@ -625,14 +558,12 @@ vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
|
|||||||
type_smob *t_smob
|
type_smob *t_smob
|
||||||
= tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
|
= tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
|
||||||
struct type *type = tyscm_type_smob_type (t_smob);
|
struct type *type = tyscm_type_smob_type (t_smob);
|
||||||
SCM result;
|
|
||||||
struct value *res_val = NULL;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
{
|
||||||
|
scoped_value_mark free_values;
|
||||||
|
|
||||||
|
struct value *res_val;
|
||||||
if (op == UNOP_DYNAMIC_CAST)
|
if (op == UNOP_DYNAMIC_CAST)
|
||||||
res_val = value_dynamic_cast (type, value);
|
res_val = value_dynamic_cast (type, value);
|
||||||
else if (op == UNOP_REINTERPRET_CAST)
|
else if (op == UNOP_REINTERPRET_CAST)
|
||||||
@ -642,22 +573,9 @@ vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
|
|||||||
gdb_assert (op == UNOP_CAST);
|
gdb_assert (op == UNOP_CAST);
|
||||||
res_val = value_cast (type, value);
|
res_val = value_cast (type, value);
|
||||||
}
|
}
|
||||||
}
|
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
gdb_assert (res_val != NULL);
|
return vlscm_scm_from_value (res_val);
|
||||||
result = vlscm_scm_from_value (res_val);
|
});
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
|
||||||
gdbscm_throw (result);
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
|
/* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
|
||||||
@ -693,42 +611,29 @@ gdbscm_value_field (SCM self, SCM field_scm)
|
|||||||
{
|
{
|
||||||
value_smob *v_smob
|
value_smob *v_smob
|
||||||
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
struct value *value = v_smob->value;
|
|
||||||
char *field = NULL;
|
|
||||||
struct value *res_val = NULL;
|
|
||||||
SCM result;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
||||||
_("string"));
|
_("string"));
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
|
|
||||||
field = gdbscm_scm_to_c_string (field_scm);
|
|
||||||
make_cleanup (xfree, field);
|
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
{
|
||||||
struct value *tmp = value;
|
scoped_value_mark free_values;
|
||||||
|
|
||||||
res_val = value_struct_elt (&tmp, NULL, field, NULL,
|
char *field = gdbscm_scm_to_c_string (field_scm);
|
||||||
"struct/class/union");
|
|
||||||
}
|
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
gdb_assert (res_val != NULL);
|
struct cleanup *cleanups = make_cleanup (xfree, field);
|
||||||
result = vlscm_scm_from_value (res_val);
|
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
struct value *tmp = v_smob->value;
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
struct value *res_val = value_struct_elt (&tmp, NULL, field, NULL,
|
||||||
gdbscm_throw (result);
|
"struct/class/union");
|
||||||
|
|
||||||
return result;
|
SCM result = vlscm_scm_from_value (res_val);
|
||||||
|
|
||||||
|
do_cleanups (cleanups);
|
||||||
|
|
||||||
|
return result;
|
||||||
|
});
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
|
/* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
|
||||||
@ -740,61 +645,36 @@ gdbscm_value_subscript (SCM self, SCM index_scm)
|
|||||||
value_smob *v_smob
|
value_smob *v_smob
|
||||||
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
struct value *value = v_smob->value;
|
struct value *value = v_smob->value;
|
||||||
struct value *index = NULL;
|
|
||||||
struct value *res_val = NULL;
|
|
||||||
struct type *type = value_type (value);
|
struct type *type = value_type (value);
|
||||||
struct gdbarch *gdbarch;
|
|
||||||
SCM result, except_scm;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
/* The sequencing here, as everywhere else, is important.
|
|
||||||
We can't have existing cleanups when a Scheme exception is thrown. */
|
|
||||||
|
|
||||||
SCM_ASSERT (type != NULL, self, SCM_ARG2, FUNC_NAME);
|
SCM_ASSERT (type != NULL, self, SCM_ARG2, FUNC_NAME);
|
||||||
gdbarch = get_type_arch (type);
|
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
|
{
|
||||||
|
scoped_value_mark free_values;
|
||||||
|
|
||||||
index = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
|
SCM except_scm;
|
||||||
|
struct value *index
|
||||||
|
= vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
|
||||||
&except_scm,
|
&except_scm,
|
||||||
gdbarch, current_language);
|
get_type_arch (type),
|
||||||
if (index == NULL)
|
current_language);
|
||||||
{
|
if (index == NULL)
|
||||||
do_cleanups (cleanups);
|
return except_scm;
|
||||||
gdbscm_throw (except_scm);
|
|
||||||
}
|
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
|
||||||
struct value *tmp = value;
|
|
||||||
|
|
||||||
/* Assume we are attempting an array access, and let the value code
|
/* Assume we are attempting an array access, and let the value code
|
||||||
throw an exception if the index has an invalid type.
|
throw an exception if the index has an invalid type.
|
||||||
Check the value's type is something that can be accessed via
|
Check the value's type is something that can be accessed via
|
||||||
a subscript. */
|
a subscript. */
|
||||||
tmp = coerce_ref (tmp);
|
struct value *tmp = coerce_ref (value);
|
||||||
type = check_typedef (value_type (tmp));
|
struct type *tmp_type = check_typedef (value_type (tmp));
|
||||||
if (TYPE_CODE (type) != TYPE_CODE_ARRAY
|
if (TYPE_CODE (tmp_type) != TYPE_CODE_ARRAY
|
||||||
&& TYPE_CODE (type) != TYPE_CODE_PTR)
|
&& TYPE_CODE (tmp_type) != TYPE_CODE_PTR)
|
||||||
error (_("Cannot subscript requested type"));
|
error (_("Cannot subscript requested type"));
|
||||||
|
|
||||||
res_val = value_subscript (tmp, value_as_long (index));
|
struct value *res_val = value_subscript (tmp, value_as_long (index));
|
||||||
}
|
return vlscm_scm_from_value (res_val);
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
});
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
|
||||||
}
|
|
||||||
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 result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-call <gdb:value> arg-list) -> <gdb:value>
|
/* (value-call <gdb:value> arg-list) -> <gdb:value>
|
||||||
@ -854,25 +734,14 @@ gdbscm_value_call (SCM self, SCM args)
|
|||||||
gdb_assert (gdbscm_is_true (scm_null_p (args)));
|
gdb_assert (gdbscm_is_true (scm_null_p (args)));
|
||||||
}
|
}
|
||||||
|
|
||||||
TRY
|
return gdbscm_wrap ([=]
|
||||||
{
|
{
|
||||||
struct cleanup *cleanup = make_cleanup_value_free_to_mark (mark);
|
scoped_value_mark free_values;
|
||||||
struct value *return_value;
|
|
||||||
|
|
||||||
return_value = call_function_by_hand (function, NULL, args_count, vargs);
|
value *return_value = call_function_by_hand (function, NULL,
|
||||||
result = vlscm_scm_from_value (return_value);
|
args_count, vargs);
|
||||||
do_cleanups (cleanup);
|
return vlscm_scm_from_value (return_value);
|
||||||
}
|
});
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
|
||||||
gdbscm_throw (result);
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value->bytevector <gdb:value>) -> bytevector */
|
/* (value->bytevector <gdb:value>) -> bytevector */
|
||||||
@ -1105,12 +974,11 @@ gdbscm_value_to_string (SCM self, SCM rest)
|
|||||||
int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
|
int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
|
||||||
char *encoding = NULL;
|
char *encoding = NULL;
|
||||||
SCM errors = SCM_BOOL_F;
|
SCM errors = SCM_BOOL_F;
|
||||||
|
gdb_byte *buffer_contents;
|
||||||
int length = -1;
|
int length = -1;
|
||||||
gdb::unique_xmalloc_ptr<gdb_byte> buffer;
|
|
||||||
const char *la_encoding = NULL;
|
const char *la_encoding = NULL;
|
||||||
struct type *char_type = NULL;
|
struct type *char_type = NULL;
|
||||||
SCM result;
|
SCM result;
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
/* The sequencing here, as everywhere else, is important.
|
/* The sequencing here, as everywhere else, is important.
|
||||||
We can't have existing cleanups when a Scheme exception is thrown. */
|
We can't have existing cleanups when a Scheme exception is thrown. */
|
||||||
@ -1120,8 +988,6 @@ gdbscm_value_to_string (SCM self, SCM rest)
|
|||||||
&errors_arg_pos, &errors,
|
&errors_arg_pos, &errors,
|
||||||
&length_arg_pos, &length);
|
&length_arg_pos, &length);
|
||||||
|
|
||||||
cleanups = make_cleanup (xfree, encoding);
|
|
||||||
|
|
||||||
if (errors_arg_pos > 0
|
if (errors_arg_pos > 0
|
||||||
&& errors != SCM_BOOL_F
|
&& errors != SCM_BOOL_F
|
||||||
&& !scm_is_eq (errors, error_symbol)
|
&& !scm_is_eq (errors, error_symbol)
|
||||||
@ -1131,7 +997,7 @@ gdbscm_value_to_string (SCM self, SCM rest)
|
|||||||
= gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
|
= gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
|
||||||
_("invalid error kind"));
|
_("invalid error kind"));
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
xfree (encoding);
|
||||||
gdbscm_throw (excp);
|
gdbscm_throw (excp);
|
||||||
}
|
}
|
||||||
if (errors == SCM_BOOL_F)
|
if (errors == SCM_BOOL_F)
|
||||||
@ -1148,22 +1014,23 @@ gdbscm_value_to_string (SCM self, SCM rest)
|
|||||||
|
|
||||||
TRY
|
TRY
|
||||||
{
|
{
|
||||||
|
gdb::unique_xmalloc_ptr<gdb_byte> buffer;
|
||||||
LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
|
LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
|
||||||
|
buffer_contents = buffer.release ();
|
||||||
}
|
}
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
CATCH (except, RETURN_MASK_ALL)
|
||||||
{
|
{
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
xfree (encoding);
|
||||||
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||||
}
|
}
|
||||||
END_CATCH
|
END_CATCH
|
||||||
|
|
||||||
/* If errors is "error" scm_from_stringn may throw a Scheme exception.
|
/* If errors is "error", scm_from_stringn may throw a Scheme exception.
|
||||||
Make sure we don't leak. This is done via scm_dynwind_begin, et.al. */
|
Make sure we don't leak. This is done via scm_dynwind_begin, et.al. */
|
||||||
discard_cleanups (cleanups);
|
|
||||||
|
|
||||||
scm_dynwind_begin ((scm_t_dynwind_flags) 0);
|
scm_dynwind_begin ((scm_t_dynwind_flags) 0);
|
||||||
|
|
||||||
gdbscm_dynwind_xfree (encoding);
|
gdbscm_dynwind_xfree (encoding);
|
||||||
gdb_byte *buffer_contents = buffer.release ();
|
|
||||||
gdbscm_dynwind_xfree (buffer_contents);
|
gdbscm_dynwind_xfree (buffer_contents);
|
||||||
|
|
||||||
result = scm_from_stringn ((const char *) buffer_contents,
|
result = scm_from_stringn ((const char *) buffer_contents,
|
||||||
@ -1202,7 +1069,6 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
|
|||||||
char *encoding = NULL;
|
char *encoding = NULL;
|
||||||
int length = -1;
|
int length = -1;
|
||||||
SCM result = SCM_BOOL_F; /* -Wall */
|
SCM result = SCM_BOOL_F; /* -Wall */
|
||||||
struct cleanup *cleanups;
|
|
||||||
struct gdb_exception except = exception_none;
|
struct gdb_exception except = exception_none;
|
||||||
|
|
||||||
/* The sequencing here, as everywhere else, is important.
|
/* The sequencing here, as everywhere else, is important.
|
||||||
@ -1219,12 +1085,10 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
|
|||||||
_("invalid length"));
|
_("invalid length"));
|
||||||
}
|
}
|
||||||
|
|
||||||
cleanups = make_cleanup (xfree, encoding);
|
|
||||||
|
|
||||||
TRY
|
TRY
|
||||||
{
|
{
|
||||||
struct cleanup *inner_cleanup
|
scoped_value_mark free_values;
|
||||||
= make_cleanup_value_free_to_mark (value_mark ());
|
|
||||||
struct type *type, *realtype;
|
struct type *type, *realtype;
|
||||||
CORE_ADDR addr;
|
CORE_ADDR addr;
|
||||||
|
|
||||||
@ -1275,8 +1139,6 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
|
|||||||
}
|
}
|
||||||
|
|
||||||
result = lsscm_make_lazy_string (addr, length, encoding, type);
|
result = lsscm_make_lazy_string (addr, length, encoding, type);
|
||||||
|
|
||||||
do_cleanups (inner_cleanup);
|
|
||||||
}
|
}
|
||||||
CATCH (ex, RETURN_MASK_ALL)
|
CATCH (ex, RETURN_MASK_ALL)
|
||||||
{
|
{
|
||||||
@ -1284,7 +1146,7 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
|
|||||||
}
|
}
|
||||||
END_CATCH
|
END_CATCH
|
||||||
|
|
||||||
do_cleanups (cleanups);
|
xfree (encoding);
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||||||
|
|
||||||
if (gdbscm_is_exception (result))
|
if (gdbscm_is_exception (result))
|
||||||
@ -1314,18 +1176,12 @@ gdbscm_value_fetch_lazy_x (SCM self)
|
|||||||
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||||||
struct value *value = v_smob->value;
|
struct value *value = v_smob->value;
|
||||||
|
|
||||||
TRY
|
return gdbscm_wrap ([=]
|
||||||
{
|
{
|
||||||
if (value_lazy (value))
|
if (value_lazy (value))
|
||||||
value_fetch_lazy (value);
|
value_fetch_lazy (value);
|
||||||
}
|
return SCM_UNSPECIFIED;
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
});
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (value-print <gdb:value>) -> string */
|
/* (value-print <gdb:value>) -> string */
|
||||||
@ -1369,38 +1225,14 @@ static SCM
|
|||||||
gdbscm_parse_and_eval (SCM expr_scm)
|
gdbscm_parse_and_eval (SCM expr_scm)
|
||||||
{
|
{
|
||||||
char *expr_str;
|
char *expr_str;
|
||||||
struct value *res_val = NULL;
|
|
||||||
SCM result;
|
|
||||||
struct cleanup *cleanups;
|
|
||||||
|
|
||||||
/* The sequencing here, as everywhere else, is important.
|
|
||||||
We can't have existing cleanups when a Scheme exception is thrown. */
|
|
||||||
|
|
||||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
|
||||||
expr_scm, &expr_str);
|
expr_scm, &expr_str);
|
||||||
|
|
||||||
cleanups = make_cleanup_value_free_to_mark (value_mark ());
|
return gdbscm_wrap ([=]
|
||||||
make_cleanup (xfree, expr_str);
|
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
{
|
||||||
res_val = parse_and_eval (expr_str);
|
scoped_value_mark free_values;
|
||||||
}
|
return vlscm_scm_from_value (parse_and_eval (expr_str));
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
});
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
|
||||||
}
|
|
||||||
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 result;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (history-ref integer) -> <gdb:value>
|
/* (history-ref integer) -> <gdb:value>
|
||||||
@ -1410,21 +1242,12 @@ static SCM
|
|||||||
gdbscm_history_ref (SCM index)
|
gdbscm_history_ref (SCM index)
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
struct value *res_val = NULL; /* Initialize to appease gcc warning. */
|
|
||||||
|
|
||||||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
|
||||||
|
|
||||||
TRY
|
return gdbscm_wrap ([=]
|
||||||
{
|
{
|
||||||
res_val = access_value_history (i);
|
return vlscm_scm_from_value (access_value_history (i));
|
||||||
}
|
});
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
return vlscm_scm_from_value (res_val);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (history-append! <gdb:value>) -> index
|
/* (history-append! <gdb:value>) -> index
|
||||||
@ -1433,24 +1256,12 @@ gdbscm_history_ref (SCM index)
|
|||||||
static SCM
|
static SCM
|
||||||
gdbscm_history_append_x (SCM value)
|
gdbscm_history_append_x (SCM value)
|
||||||
{
|
{
|
||||||
int res_index = -1;
|
value_smob *v_smob
|
||||||
struct value *v;
|
= vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
|
||||||
value_smob *v_smob;
|
return gdbscm_wrap ([=]
|
||||||
|
|
||||||
v_smob = vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
|
|
||||||
v = v_smob->value;
|
|
||||||
|
|
||||||
TRY
|
|
||||||
{
|
{
|
||||||
res_index = record_latest_value (v);
|
return scm_from_int (record_latest_value (v_smob->value));
|
||||||
}
|
});
|
||||||
CATCH (except, RETURN_MASK_ALL)
|
|
||||||
{
|
|
||||||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
||||||
}
|
|
||||||
END_CATCH
|
|
||||||
|
|
||||||
return scm_from_int (res_index);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Initialize the Scheme value code. */
|
/* Initialize the Scheme value code. */
|
||||||
|
Reference in New Issue
Block a user