/* Scheme interface to values.
- Copyright (C) 2008-2017 Free Software Foundation, Inc.
+ Copyright (C) 2008-2019 Free Software Foundation, Inc.
This file is part of GDB.
#include "arch-utils.h"
#include "charset.h"
#include "cp-abi.h"
+#include "target-float.h"
#include "infcall.h"
#include "symtab.h" /* Needed by language.h. */
#include "language.h"
value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
vlscm_forget_value_smob (v_smob);
- value_free (v_smob->value);
+ value_decref (v_smob->value);
return 0;
}
instead of writingp. */
opts.raw = !!pstate->writingp;
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
string_file stb;
common_val_print (v_smob->value, &stb, 0, &opts, current_language);
scm_puts (stb.c_str (), port);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
if (pstate->writingp)
scm_puts (">", port);
const value_smob *v2_smob = (value_smob *) SCM_SMOB_DATA (v2);
int result = 0;
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
result = value_equal (v1_smob->value, v2_smob->value);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return scm_from_bool (result);
}
SCM v_scm = vlscm_make_value_smob ();
value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
- v_smob->value = value;
- release_value_or_incref (value);
+ v_smob->value = release_value (value).release ();
vlscm_remember_scheme_value (v_smob);
return v_scm;
static SCM
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 };
+
int type_arg_pos = -1;
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,
&type_arg_pos, &type_scm);
+ struct type *type = NULL;
if (type_arg_pos > 0)
{
- t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, type_arg_pos,
- FUNC_NAME);
+ type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
+ type_arg_pos,
+ FUNC_NAME);
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,
&except_scm,
- gdbarch, language);
- if (value == NULL)
- {
- do_cleanups (cleanups);
- gdbscm_throw (except_scm);
- }
-
- result = vlscm_scm_from_value (value);
-
- do_cleanups (cleanups);
+ get_current_arch (),
+ current_language);
+ if (value == NULL)
+ return except_scm;
- if (gdbscm_is_exception (result))
- gdbscm_throw (result);
- return result;
+ return vlscm_scm_from_value (value);
+ });
}
/* (make-lazy-value <gdb:type> address) -> <gdb:value> */
static SCM
gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
{
- type_smob *t_smob;
- struct type *type;
- 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);
+ type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
+ SCM_ARG1, FUNC_NAME);
+ struct type *type = tyscm_type_smob_type (t_smob);
+ ULONGEST address;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
address_scm, &address);
- cleanups = make_cleanup_value_free_to_mark (value_mark ());
-
- /* 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)
+ return gdbscm_wrap ([=]
{
- GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
- }
- END_CATCH
-
- result = vlscm_scm_from_value (value);
-
- do_cleanups (cleanups);
+ scoped_value_mark free_values;
- if (gdbscm_is_exception (result))
- gdbscm_throw (result);
- return result;
+ struct value *value = value_from_contents_and_address (type, NULL,
+ address);
+ return vlscm_scm_from_value (value);
+ });
}
/* (value-optimized-out? <gdb:value>) -> boolean */
{
value_smob *v_smob
= 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);
- }
- CATCH (except, RETURN_MASK_ALL)
- {
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
- }
- END_CATCH
-
- return scm_from_bool (opt);
+ return scm_from_bool (value_optimized_out (v_smob->value));
+ });
}
/* (value-address <gdb:value>) -> integer
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
- if (SCM_UNBNDP (v_smob->address))
+ return gdbscm_wrap ([=]
{
- struct value *res_val = NULL;
- struct cleanup *cleanup
- = make_cleanup_value_free_to_mark (value_mark ());
- SCM address;
-
- TRY
+ if (SCM_UNBNDP (v_smob->address))
{
- res_val = value_addr (value);
- }
- CATCH (except, RETURN_MASK_ALL)
- {
- address = SCM_BOOL_F;
- }
- END_CATCH
+ scoped_value_mark free_values;
- if (res_val != NULL)
- address = vlscm_scm_from_value (res_val);
+ SCM address = SCM_BOOL_F;
- do_cleanups (cleanup);
+ try
+ {
+ address = vlscm_scm_from_value (value_addr (value));
+ }
+ catch (const gdb_exception &except)
+ {
+ }
- if (gdbscm_is_exception (address))
- gdbscm_throw (address);
+ if (gdbscm_is_exception (address))
+ return address;
- v_smob->address = address;
- }
+ v_smob->address = address;
+ }
- return v_smob->address;
+ return v_smob->address;
+ });
}
/* (value-dereference <gdb:value>) -> <gdb:value>
{
value_smob *v_smob
= 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 ());
-
- TRY
- {
- res_val = value_ind (value);
- }
- CATCH (except, RETURN_MASK_ALL)
+ return gdbscm_wrap ([=]
{
- GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
- }
- END_CATCH
-
- result = vlscm_scm_from_value (res_val);
-
- do_cleanups (cleanups);
-
- if (gdbscm_is_exception (result))
- gdbscm_throw (result);
+ scoped_value_mark free_values;
- return result;
+ struct value *res_val = value_ind (v_smob->value);
+ return vlscm_scm_from_value (res_val);
+ });
}
/* (value-referenced-value <gdb:value>) -> <gdb:value>
value_smob *v_smob
= 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 ());
- TRY
+ return gdbscm_wrap ([=]
{
+ scoped_value_mark free_values;
+
+ struct value *res_val;
+
switch (TYPE_CODE (check_typedef (value_type (value))))
{
case TYPE_CODE_PTR:
error (_("Trying to get the referenced value from a value which is"
" 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);
-
- do_cleanups (cleanups);
-
- if (gdbscm_is_exception (result))
- gdbscm_throw (result);
-
- return result;
+ return vlscm_scm_from_value (res_val);
+ });
}
/* (value-type <gdb:value>) -> <gdb:type> */
if (! SCM_UNBNDP (v_smob->dynamic_type))
return v_smob->dynamic_type;
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
- struct cleanup *cleanup
- = make_cleanup_value_free_to_mark (value_mark ());
+ scoped_value_mark free_values;
type = value_type (value);
type = check_typedef (type);
/* Re-use object's static type. */
type = NULL;
}
-
- do_cleanups (cleanup);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
if (type == NULL)
v_smob->dynamic_type = gdbscm_value_type (self);
else
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
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 ());
-
- TRY
+ return gdbscm_wrap ([=]
{
+ scoped_value_mark free_values;
+
+ struct value *res_val;
if (op == UNOP_DYNAMIC_CAST)
res_val = value_dynamic_cast (type, value);
else if (op == UNOP_REINTERPRET_CAST)
gdb_assert (op == UNOP_CAST);
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);
- result = vlscm_scm_from_value (res_val);
-
- do_cleanups (cleanups);
- if (gdbscm_is_exception (result))
- gdbscm_throw (result);
-
- return result;
+ return vlscm_scm_from_value (res_val);
+ });
}
/* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
{
value_smob *v_smob
= 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,
_("string"));
- cleanups = make_cleanup_value_free_to_mark (value_mark ());
-
- field = gdbscm_scm_to_c_string (field_scm);
- make_cleanup (xfree, field);
-
- TRY
- {
- struct value *tmp = value;
-
- res_val = value_struct_elt (&tmp, NULL, field, NULL,
- "struct/class/union");
- }
- CATCH (except, RETURN_MASK_ALL)
+ return gdbscm_wrap ([=]
{
- GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
- }
- END_CATCH
+ scoped_value_mark free_values;
- gdb_assert (res_val != NULL);
- result = vlscm_scm_from_value (res_val);
+ gdb::unique_xmalloc_ptr<char> field = gdbscm_scm_to_c_string (field_scm);
- do_cleanups (cleanups);
+ struct value *tmp = v_smob->value;
- if (gdbscm_is_exception (result))
- gdbscm_throw (result);
+ struct value *res_val = value_struct_elt (&tmp, NULL, field.get (), NULL,
+ "struct/class/union");
- return result;
+ return vlscm_scm_from_value (res_val);
+ });
}
/* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
- struct value *index = NULL;
- struct value *res_val = NULL;
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);
- gdbarch = get_type_arch (type);
- cleanups = make_cleanup_value_free_to_mark (value_mark ());
-
- index = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
- &except_scm,
- gdbarch, current_language);
- if (index == NULL)
+ return gdbscm_wrap ([=]
{
- do_cleanups (cleanups);
- gdbscm_throw (except_scm);
- }
+ scoped_value_mark free_values;
- TRY
- {
- struct value *tmp = value;
+ SCM except_scm;
+ struct value *index
+ = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
+ &except_scm,
+ get_type_arch (type),
+ current_language);
+ if (index == NULL)
+ return except_scm;
/* Assume we are attempting an array access, and let the value code
throw an exception if the index has an invalid type.
Check the value's type is something that can be accessed via
a subscript. */
- tmp = coerce_ref (tmp);
- type = check_typedef (value_type (tmp));
- if (TYPE_CODE (type) != TYPE_CODE_ARRAY
- && TYPE_CODE (type) != TYPE_CODE_PTR)
+ struct value *tmp = coerce_ref (value);
+ struct type *tmp_type = check_typedef (value_type (tmp));
+ if (TYPE_CODE (tmp_type) != TYPE_CODE_ARRAY
+ && TYPE_CODE (tmp_type) != TYPE_CODE_PTR)
error (_("Cannot subscript requested type"));
- res_val = value_subscript (tmp, value_as_long (index));
- }
- 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;
+ struct value *res_val = value_subscript (tmp, value_as_long (index));
+ return vlscm_scm_from_value (res_val);
+ });
}
/* (value-call <gdb:value> arg-list) -> <gdb:value>
value_smob *v_smob
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *function = v_smob->value;
- struct value *mark = value_mark ();
struct type *ftype = NULL;
long args_count;
struct value **vargs = NULL;
- SCM result = SCM_BOOL_F;
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
ftype = check_typedef (value_type (function));
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
SCM_ASSERT_TYPE (TYPE_CODE (ftype) == TYPE_CODE_FUNC, self,
SCM_ARG1, FUNC_NAME,
_("function (value of TYPE_CODE_FUNC)"));
gdb_assert (gdbscm_is_true (scm_null_p (args)));
}
- TRY
- {
- struct cleanup *cleanup = make_cleanup_value_free_to_mark (mark);
- struct value *return_value;
-
- return_value = call_function_by_hand (function, args_count, vargs);
- result = vlscm_scm_from_value (return_value);
- do_cleanups (cleanup);
- }
- CATCH (except, RETURN_MASK_ALL)
+ return gdbscm_wrap ([=]
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
- }
- END_CATCH
-
- if (gdbscm_is_exception (result))
- gdbscm_throw (result);
+ scoped_value_mark free_values;
- return result;
+ auto av = gdb::make_array_view (vargs, args_count);
+ value *return_value = call_function_by_hand (function, NULL, av);
+ return vlscm_scm_from_value (return_value);
+ });
}
/* (value->bytevector <gdb:value>) -> bytevector */
type = value_type (value);
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
type = check_typedef (type);
length = TYPE_LENGTH (type);
contents = value_contents (value);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
bv = scm_c_make_bytevector (length);
memcpy (SCM_BYTEVECTOR_CONTENTS (bv), contents, length);
type = value_type (value);
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
type = check_typedef (type);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
_("integer-like gdb value"));
- TRY
+ try
{
if (TYPE_CODE (type) == TYPE_CODE_PTR)
l = value_as_address (value);
else
l = value_as_long (value);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return scm_from_bool (l != 0);
}
type = value_type (value);
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
type = check_typedef (type);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
_("integer-like gdb value"));
- TRY
+ try
{
if (TYPE_CODE (type) == TYPE_CODE_PTR)
l = value_as_address (value);
else
l = value_as_long (value);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
if (TYPE_UNSIGNED (type))
return gdbscm_scm_from_ulongest (l);
else
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
struct type *type;
- DOUBLEST d = 0;
+ double d = 0;
+ struct value *check = nullptr;
type = value_type (value);
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
type = check_typedef (type);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
SCM_ASSERT_TYPE (is_intlike (type, 0) || TYPE_CODE (type) == TYPE_CODE_FLT,
self, SCM_ARG1, FUNC_NAME, _("number"));
- TRY
+ try
{
- d = value_as_double (value);
+ if (is_floating_value (value))
+ {
+ d = target_float_to_host_double (value_contents (value), type);
+ check = value_from_host_double (type, d);
+ }
+ else if (TYPE_UNSIGNED (type))
+ {
+ d = (ULONGEST) value_as_long (value);
+ check = value_from_ulongest (type, (ULONGEST) d);
+ }
+ else
+ {
+ d = value_as_long (value);
+ check = value_from_longest (type, (LONGEST) d);
+ }
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
/* TODO: Is there a better way to check if the value fits? */
- if (d != (double) d)
+ if (!value_equal (value, check))
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
_("number can't be converted to a double"));
int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
char *encoding = NULL;
SCM errors = SCM_BOOL_F;
+ /* Avoid an uninitialized warning from gcc. */
+ gdb_byte *buffer_contents = nullptr;
int length = -1;
- gdb_byte *buffer = NULL;
const char *la_encoding = NULL;
struct type *char_type = 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. */
&errors_arg_pos, &errors,
&length_arg_pos, &length);
- cleanups = make_cleanup (xfree, encoding);
-
if (errors_arg_pos > 0
&& errors != SCM_BOOL_F
&& !scm_is_eq (errors, error_symbol)
= gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
_("invalid error kind"));
- do_cleanups (cleanups);
+ xfree (encoding);
gdbscm_throw (excp);
}
if (errors == SCM_BOOL_F)
/* We don't assume anything about the result of scm_port_conversion_strategy.
From this point on, if errors is not 'errors, use 'substitute. */
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
- LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
+ gdb::unique_xmalloc_ptr<gdb_byte> buffer;
+ c_get_string (value, &buffer, &length, &char_type, &la_encoding);
+ buffer_contents = buffer.release ();
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+ xfree (encoding);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
- /* 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. */
- discard_cleanups (cleanups);
scm_dynwind_begin ((scm_t_dynwind_flags) 0);
gdbscm_dynwind_xfree (encoding);
- gdbscm_dynwind_xfree (buffer);
+ gdbscm_dynwind_xfree (buffer_contents);
- result = scm_from_stringn ((const char *) buffer,
+ result = scm_from_stringn ((const char *) buffer_contents,
length * TYPE_LENGTH (char_type),
(encoding != NULL && *encoding != '\0'
? encoding
char *encoding = NULL;
int length = -1;
SCM result = SCM_BOOL_F; /* -Wall */
- struct cleanup *cleanups;
- struct gdb_exception except = exception_none;
+ gdbscm_gdb_exception except {};
/* The sequencing here, as everywhere else, is important.
We can't have existing cleanups when a Scheme exception is thrown. */
_("invalid length"));
}
- cleanups = make_cleanup (xfree, encoding);
-
- TRY
+ try
{
- struct cleanup *inner_cleanup
- = make_cleanup_value_free_to_mark (value_mark ());
+ scoped_value_mark free_values;
+
struct type *type, *realtype;
CORE_ADDR addr;
}
result = lsscm_make_lazy_string (addr, length, encoding, type);
-
- do_cleanups (inner_cleanup);
}
- CATCH (ex, RETURN_MASK_ALL)
+ catch (const gdb_exception &ex)
{
- except = ex;
+ except = unpack (ex);
}
- END_CATCH
- do_cleanups (cleanups);
+ xfree (encoding);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (gdbscm_is_exception (result))
= vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct value *value = v_smob->value;
- TRY
+ return gdbscm_wrap ([=]
{
if (value_lazy (value))
value_fetch_lazy (value);
- }
- CATCH (except, RETURN_MASK_ALL)
- {
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
- }
- END_CATCH
-
- return SCM_UNSPECIFIED;
+ return SCM_UNSPECIFIED;
+ });
}
/* (value-print <gdb:value>) -> string */
string_file stb;
- TRY
+ gdbscm_gdb_exception exc {};
+ try
{
common_val_print (value, &stb, 0, &opts, current_language);
}
- CATCH (except, RETURN_MASK_ALL)
+ catch (const gdb_exception &except)
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ exc = unpack (except);
}
- END_CATCH
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
/* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
throw an error if the encoding fails.
IWBN to use scm_take_locale_string here, but we'd have to temporarily
gdbscm_parse_and_eval (SCM expr_scm)
{
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",
expr_scm, &expr_str);
- cleanups = make_cleanup_value_free_to_mark (value_mark ());
- make_cleanup (xfree, expr_str);
-
- TRY
+ return gdbscm_wrap ([=]
{
- res_val = 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;
+ scoped_value_mark free_values;
+ return vlscm_scm_from_value (parse_and_eval (expr_str));
+ });
}
/* (history-ref integer) -> <gdb:value>
gdbscm_history_ref (SCM index)
{
int i;
- struct value *res_val = NULL; /* Initialize to appease gcc warning. */
-
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
- TRY
- {
- res_val = access_value_history (i);
- }
- CATCH (except, RETURN_MASK_ALL)
+ return gdbscm_wrap ([=]
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
- }
- END_CATCH
-
- return vlscm_scm_from_value (res_val);
+ return vlscm_scm_from_value (access_value_history (i));
+ });
}
/* (history-append! <gdb:value>) -> index
static SCM
gdbscm_history_append_x (SCM value)
{
- int res_index = -1;
- struct value *v;
- value_smob *v_smob;
-
- v_smob = vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
- v = v_smob->value;
-
- TRY
- {
- res_index = record_latest_value (v);
- }
- CATCH (except, RETURN_MASK_ALL)
+ value_smob *v_smob
+ = vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
+ return gdbscm_wrap ([=]
{
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
- }
- END_CATCH
-
- return scm_from_int (res_index);
+ return scm_from_int (record_latest_value (v_smob->value));
+ });
}
\f
/* Initialize the Scheme value code. */
projects / deliverable / binutils-gdb.git / blobdiff