[RFA 0/4] some simple cleanup removal in guile

[RFA 0/4] some simple cleanup removal in guile

[Tom Tromey]

This series removes cleanups from a few spots in the guile directory.
It only removes things that I considered fairly straightforward.

Tested by the buildbot.

Tom

[RFA 3/4] Return unique_xmalloc_ptr from gdbscm_safe_eval_string

[Tom Tromey]

This changes gdbscm_safe_eval_string to return a unique_xmalloc_ptr.
This allows for the removal of some cleanups.  It also fixes a
potential latent memory leak in gdbscm_set_backtrace.

2018-05-26  Tom Tromey  <tom@tromey.com>

	* guile/guile.c (gdbscm_eval_from_control_command): Update.
	* guile/guile-internal.h (gdbscm_safe_eval_string): Update.
	* guile/scm-objfile.c (gdbscm_execute_objfile_script): Update.
	* guile/scm-safe-call.c (gdbscm_safe_eval_string): Return
	unique_xmalloc_ptr.
---
 gdb/ChangeLog              |  8 ++++++++
 gdb/guile/guile-internal.h |  3 ++-
 gdb/guile/guile.c          | 23 +++++------------------
 gdb/guile/scm-objfile.c    | 10 +++-------
 gdb/guile/scm-safe-call.c  |  6 +++---
 5 files changed, 21 insertions(+), 29 deletions(-)

diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
index 20e2c70e16..2bf0cf72b2 100644
--- a/gdb/guile/guile-internal.h
+++ b/gdb/guile/guile-internal.h
@@ -402,7 +402,8 @@ extern SCM gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM args,
 
 extern SCM gdbscm_unsafe_call_1 (SCM proc, SCM arg0);
 
-extern char *gdbscm_safe_eval_string (const char *string, int display_result);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_safe_eval_string
+    (const char *string, int display_result);
 
 extern char *gdbscm_safe_source_script (const char *filename);
 
diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
index 0bbbf6eac1..6b5faa38bc 100644
--- a/gdb/guile/guile.c
+++ b/gdb/guile/guile.c
@@ -197,15 +197,10 @@ guile_command (const char *arg, int from_tty)
 
   if (arg && *arg)
     {
-      char *msg = gdbscm_safe_eval_string (arg, 1);
+      gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (arg, 1);
 
       if (msg != NULL)
-	{
-	  /* It is ok that this is a "dangling cleanup" because we
-	     throw immediately.  */
-	  make_cleanup (xfree, msg);
-	  error ("%s", msg);
-	}
+	error ("%s", msg.get ());
     }
   else
     {
@@ -253,24 +248,16 @@ static void
 gdbscm_eval_from_control_command
   (const struct extension_language_defn *extlang, struct command_line *cmd)
 {
-  char *script, *msg;
-  struct cleanup *cleanup;
+  char *script;
 
   if (cmd->body_list_1 != nullptr)
     error (_("Invalid \"guile\" block structure."));
 
-  cleanup = make_cleanup (null_cleanup, NULL);
-
   script = compute_scheme_string (cmd->body_list_0.get ());
-  msg = gdbscm_safe_eval_string (script, 0);
+  gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (script, 0);
   xfree (script);
   if (msg != NULL)
-    {
-      make_cleanup (xfree, msg);
-      error ("%s", msg);
-    }
-
-  do_cleanups (cleanup);
+    error ("%s", msg.get ());
 }
 
 /* Read a file as Scheme code.
diff --git a/gdb/guile/scm-objfile.c b/gdb/guile/scm-objfile.c
index 9917119084..ccf7c66d33 100644
--- a/gdb/guile/scm-objfile.c
+++ b/gdb/guile/scm-objfile.c
@@ -336,16 +336,12 @@ gdbscm_execute_objfile_script (const struct extension_language_defn *extlang,
 			       struct objfile *objfile, const char *name,
 			       const char *script)
 {
-  char *msg;
-
   ofscm_current_objfile = objfile;
 
-  msg = gdbscm_safe_eval_string (script, 0 /* display_result */);
+  gdb::unique_xmalloc_ptr<char> msg
+    = gdbscm_safe_eval_string (script, 0 /* display_result */);
   if (msg != NULL)
-    {
-      fprintf_filtered (gdb_stderr, "%s", msg);
-      xfree (msg);
-    }
+    fprintf_filtered (gdb_stderr, "%s", msg.get ());
 
   ofscm_current_objfile = NULL;
 }
diff --git a/gdb/guile/scm-safe-call.c b/gdb/guile/scm-safe-call.c
index 2cba399e23..63c4833564 100644
--- a/gdb/guile/scm-safe-call.c
+++ b/gdb/guile/scm-safe-call.c
@@ -393,9 +393,9 @@ scscm_eval_scheme_string (void *datap)
    and preventing continuation capture.
    The result is NULL if no exception occurred.  Otherwise, the exception is
    printed according to "set guile print-stack" and the result is an error
-   message allocated with malloc, caller must free.  */
+   message.  */
 
-char *
+gdb::unique_xmalloc_ptr<char>
 gdbscm_safe_eval_string (const char *string, int display_result)
 {
   struct eval_scheme_string_data data = { string, display_result };
@@ -404,7 +404,7 @@ gdbscm_safe_eval_string (const char *string, int display_result)
   result = gdbscm_with_guile (scscm_eval_scheme_string, (void *) &data);
 
   if (result != NULL)
-    return xstrdup (result);
+    return gdb::unique_xmalloc_ptr<char> (xstrdup (result));
   return NULL;
 }
 \f
-- 
2.13.6

[RFA 1/4] Use std::string in ppscm_make_pp_type_error_exception

[Tom Tromey]

This changes ppscm_make_pp_type_error_exception to use std::string,
removing a cleanup.

ChangeLog
2018-05-26  Tom Tromey  <tom@tromey.com>

	* guile/scm-pretty-print.c (ppscm_make_pp_type_error_exception):
	Use string_printf.
---
 gdb/ChangeLog                |  5 +++++
 gdb/guile/scm-pretty-print.c | 14 ++++----------
 2 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c
index da1b7d2be1..5e8a2a998d 100644
--- a/gdb/guile/scm-pretty-print.c
+++ b/gdb/guile/scm-pretty-print.c
@@ -327,16 +327,10 @@ gdbscm_pretty_printer_worker_p (SCM scm)
 static SCM
 ppscm_make_pp_type_error_exception (const char *message, SCM object)
 {
-  char *msg = xstrprintf ("%s: ~S", message);
-  struct cleanup *cleanup = make_cleanup (xfree, msg);
-  SCM exception
-    = gdbscm_make_error (pp_type_error_symbol,
-			 NULL /* func */, msg,
-			 scm_list_1 (object), scm_list_1 (object));
-
-  do_cleanups (cleanup);
-
-  return exception;
+  std::string msg = string_printf ("%s: ~S", message);
+  return gdbscm_make_error (pp_type_error_symbol,
+			    NULL /* func */, msg.c_str (),
+			    scm_list_1 (object), scm_list_1 (object));
 }
 
 /* Print MESSAGE as an exception (meaning it is controlled by
-- 
2.13.6

[RFA 2/4] Change gdbscm_exception_message_to_string to return a unique_xmalloc_ptr

[Tom Tromey]

This changes gdbscm_exception_message_to_string to return a
unique_xmalloc_ptr, allowing for the removal of some cleanups.
unique_xmalloc_ptr was chosen because at the root of the call chains
is a function from Guile that returns a malloc'd string.

ChangeLog
2018-05-26  Tom Tromey  <tom@tromey.com>

	* guile/scm-param.c (pascm_signal_setshow_error): Update.
	* guile/guile-internal.h (gdbscm_exception_message_to_string):
	Update.
	* guile/scm-cmd.c (cmdscm_function): Update.
	* guile/scm-pretty-print.c
	(ppscm_print_exception_unless_memory_error): Update.
	* guile/scm-exception.c (gdbscm_exception_message_to_string):
	Return unique_xmalloc_ptr.
---
 gdb/ChangeLog                | 11 +++++++++++
 gdb/guile/guile-internal.h   |  3 ++-
 gdb/guile/scm-cmd.c          |  6 +++---
 gdb/guile/scm-exception.c    | 11 ++++-------
 gdb/guile/scm-param.c        |  6 +++---
 gdb/guile/scm-pretty-print.c | 17 ++++++++---------
 6 files changed, 31 insertions(+), 23 deletions(-)

diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
index 6bce58e150..20e2c70e16 100644
--- a/gdb/guile/guile-internal.h
+++ b/gdb/guile/guile-internal.h
@@ -362,7 +362,8 @@ extern void gdbscm_print_exception_with_stack (SCM port, SCM stack,
 
 extern void gdbscm_print_gdb_exception (SCM port, SCM exception);
 
-extern char *gdbscm_exception_message_to_string (SCM exception);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_exception_message_to_string
+    (SCM exception);
 
 extern excp_matcher_func gdbscm_memory_error_p;
 
diff --git a/gdb/guile/scm-cmd.c b/gdb/guile/scm-cmd.c
index 64243d1ba2..8bb46622a9 100644
--- a/gdb/guile/scm-cmd.c
+++ b/gdb/guile/scm-cmd.c
@@ -316,10 +316,10 @@ cmdscm_function (struct cmd_list_element *command,
 	 itself.  */
       if (gdbscm_user_error_p (gdbscm_exception_key (result)))
 	{
-	  char *msg = gdbscm_exception_message_to_string (result);
+	  gdb::unique_xmalloc_ptr<char> msg
+	    = gdbscm_exception_message_to_string (result);
 
-	  make_cleanup (xfree, msg);
-	  error ("%s", msg);
+	  error ("%s", msg.get ());
 	}
       else
 	{
diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c
index e4b81a1fd1..f0bcdcd49e 100644
--- a/gdb/guile/scm-exception.c
+++ b/gdb/guile/scm-exception.c
@@ -575,16 +575,13 @@ gdbscm_print_gdb_exception (SCM port, SCM exception)
 
 /* Return a string description of <gdb:exception> EXCEPTION.
    If EXCEPTION is a gdb:with-stack exception, unwrap it, a backtrace
-   is never returned as part of the result.
+   is never returned as part of the result.  */
 
-   Space for the result is malloc'd, the caller must free.  */
-
-char *
+gdb::unique_xmalloc_ptr<char>
 gdbscm_exception_message_to_string (SCM exception)
 {
   SCM port = scm_open_output_string ();
   SCM key, args;
-  char *result;
 
   gdb_assert (gdbscm_is_exception (exception));
 
@@ -601,9 +598,9 @@ gdbscm_exception_message_to_string (SCM exception)
     }
 
   gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
-  result = gdbscm_scm_to_c_string (scm_get_output_string (port));
+  gdb::unique_xmalloc_ptr<char> result
+    (gdbscm_scm_to_c_string (scm_get_output_string (port)));
   scm_close_port (port);
-
   return result;
 }
 
diff --git a/gdb/guile/scm-param.c b/gdb/guile/scm-param.c
index d48f14e55c..7ff4af9501 100644
--- a/gdb/guile/scm-param.c
+++ b/gdb/guile/scm-param.c
@@ -251,10 +251,10 @@ pascm_signal_setshow_error (SCM exception, const char *msg)
      itself.  */
   if (gdbscm_user_error_p (gdbscm_exception_key (exception)))
     {
-      char *excp_text = gdbscm_exception_message_to_string (exception);
+      gdb::unique_xmalloc_ptr<char> excp_text
+	= gdbscm_exception_message_to_string (exception);
 
-      make_cleanup (xfree, excp_text);
-      error ("%s", excp_text);
+      error ("%s", excp_text.get ());
     }
   else
     {
diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c
index 5e8a2a998d..eea524b104 100644
--- a/gdb/guile/scm-pretty-print.c
+++ b/gdb/guile/scm-pretty-print.c
@@ -614,25 +614,24 @@ ppscm_print_exception_unless_memory_error (SCM exception,
 {
   if (gdbscm_memory_error_p (gdbscm_exception_key (exception)))
     {
-      char *msg = gdbscm_exception_message_to_string (exception);
-      struct cleanup *cleanup = make_cleanup (xfree, msg);
+      gdb::unique_xmalloc_ptr<char> msg
+	= gdbscm_exception_message_to_string (exception);
 
       /* This "shouldn't happen", but play it safe.  */
-      if (msg == NULL || *msg == '\0')
+      if (msg == NULL || msg.get ()[0] == '\0')
 	fprintf_filtered (stream, _("<error reading variable>"));
       else
 	{
 	  /* Remove the trailing newline.  We could instead call a special
 	     routine for printing memory error messages, but this is easy
 	     enough for now.  */
-	  size_t len = strlen (msg);
+	  char *msg_text = msg.get ();
+	  size_t len = strlen (msg_text);
 
-	  if (msg[len - 1] == '\n')
-	    msg[len - 1] = '\0';
-	  fprintf_filtered (stream, _("<error reading variable: %s>"), msg);
+	  if (msg_text[len - 1] == '\n')
+	    msg_text[len - 1] = '\0';
+	  fprintf_filtered (stream, _("<error reading variable: %s>"), msg_text);
 	}
-
-      do_cleanups (cleanup);
     }
   else
     gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
-- 
2.13.6

[RFA 4/4] Return unique_xmalloc_ptr from gdbscm_scm_to_string

[Tom Tromey]

This changes gdbscm_scm_to_string to return a unique_xmalloc_ptr and
then fixes all the callers.  This allows for the removal of some
cleanups.

ChangeLog
2018-05-26  Tom Tromey  <tom@tromey.com>

	* guile/scm-param.c (pascm_set_func, pascm_show_func)
	(compute_enum_list, pascm_set_param_value_x)
	(gdbscm_parameter_value): Update.
	* guile/guile-internal.h (gdbscm_scm_to_string): Update.
	(gdbscm_scm_to_host_string): Update.
	* guile/scm-math.c (vlscm_convert_typed_value_from_scheme):
	Update.
	* guile/scm-cmd.c (cmdscm_add_completion): Update.
	* guile/scm-pretty-print.c (ppscm_print_string_repr): Update.
	* guile/scm-string.c (gdbscm_scm_to_string): Return
	unique_xmalloc_ptr.
	(gdbscm_scm_to_host_string): Likewise.
---
 gdb/ChangeLog                | 15 +++++++++++++++
 gdb/guile/guile-internal.h   |  8 ++++----
 gdb/guile/scm-cmd.c          |  4 ++--
 gdb/guile/scm-math.c         | 15 +++++----------
 gdb/guile/scm-param.c        | 43 ++++++++++++++++++-------------------------
 gdb/guile/scm-pretty-print.c | 11 ++++-------
 gdb/guile/scm-string.c       |  8 +++-----
 7 files changed, 51 insertions(+), 53 deletions(-)

diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
index 2bf0cf72b2..7289d25cf1 100644
--- a/gdb/guile/guile-internal.h
+++ b/gdb/guile/guile-internal.h
@@ -526,14 +526,14 @@ extern SCM gdbscm_scm_from_c_string (const char *string);
 extern SCM gdbscm_scm_from_printf (const char *format, ...)
     ATTRIBUTE_PRINTF (1, 2);
 
-extern char *gdbscm_scm_to_string (SCM string, size_t *lenp,
-				   const char *charset,
-				   int strict, SCM *except_scmp);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_string
+    (SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp);
 
 extern SCM gdbscm_scm_from_string (const char *string, size_t len,
 				   const char *charset, int strict);
 
-extern char *gdbscm_scm_to_host_string (SCM string, size_t *lenp, SCM *except);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_host_string
+    (SCM string, size_t *lenp, SCM *except);
 
 extern SCM gdbscm_scm_from_host_string (const char *string, size_t len);
 
diff --git a/gdb/guile/scm-cmd.c b/gdb/guile/scm-cmd.c
index 8bb46622a9..88a98643a9 100644
--- a/gdb/guile/scm-cmd.c
+++ b/gdb/guile/scm-cmd.c
@@ -362,8 +362,8 @@ cmdscm_add_completion (SCM completion, completion_tracker &tracker)
     }
 
   gdb::unique_xmalloc_ptr<char> item
-    (gdbscm_scm_to_string (completion, NULL, host_charset (), 1,
-			   &except_scm));
+    = gdbscm_scm_to_string (completion, NULL, host_charset (), 1,
+			    &except_scm);
   if (item == NULL)
     {
       /* Inform the user, but otherwise ignore the entire result.  */
diff --git a/gdb/guile/scm-math.c b/gdb/guile/scm-math.c
index 750b6bb415..5507dd7d89 100644
--- a/gdb/guile/scm-math.c
+++ b/gdb/guile/scm-math.c
@@ -826,7 +826,6 @@ vlscm_convert_typed_value_from_scheme (const char *func_name,
 	}
       else if (scm_is_string (obj))
 	{
-	  char *s;
 	  size_t len;
 	  struct cleanup *cleanup;
 
@@ -840,19 +839,15 @@ vlscm_convert_typed_value_from_scheme (const char *func_name,
 	  else
 	    {
 	      /* TODO: Provide option to specify conversion strategy.  */
-	      s = gdbscm_scm_to_string (obj, &len,
+	      gdb::unique_xmalloc_ptr<char> s
+		= gdbscm_scm_to_string (obj, &len,
 					target_charset (gdbarch),
 					0 /*non-strict*/,
 					&except_scm);
 	      if (s != NULL)
-		{
-		  cleanup = make_cleanup (xfree, s);
-		  value
-		    = value_cstring (s, len,
-				     language_string_char_type (language,
-								gdbarch));
-		  do_cleanups (cleanup);
-		}
+		value = value_cstring (s.get (), len,
+				       language_string_char_type (language,
+								  gdbarch));
 	      else
 		value = NULL;
 	    }
diff --git a/gdb/guile/scm-param.c b/gdb/guile/scm-param.c
index 7ff4af9501..29ebf0ec69 100644
--- a/gdb/guile/scm-param.c
+++ b/gdb/guile/scm-param.c
@@ -273,8 +273,6 @@ pascm_set_func (const char *args, int from_tty, struct cmd_list_element *c)
 {
   param_smob *p_smob = (param_smob *) get_cmd_context (c);
   SCM self, result, exception;
-  char *msg;
-  struct cleanup *cleanups;
 
   gdb_assert (gdbscm_is_procedure (p_smob->set_func));
 
@@ -291,18 +289,17 @@ pascm_set_func (const char *args, int from_tty, struct cmd_list_element *c)
   if (!scm_is_string (result))
     error (_("Result of %s set-func is not a string."), p_smob->name);
 
-  msg = gdbscm_scm_to_host_string (result, NULL, &exception);
+  gdb::unique_xmalloc_ptr<char> msg = gdbscm_scm_to_host_string (result, NULL,
+								 &exception);
   if (msg == NULL)
     {
       gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
       error (_("Error converting show text to host string."));
     }
 
-  cleanups = make_cleanup (xfree, msg);
   /* GDB is usually silent when a parameter is set.  */
-  if (*msg != '\0')
-    fprintf_filtered (gdb_stdout, "%s\n", msg);
-  do_cleanups (cleanups);
+  if (*msg.get () != '\0')
+    fprintf_filtered (gdb_stdout, "%s\n", msg.get ());
 }
 
 /* A callback function that is registered against the respective
@@ -316,8 +313,6 @@ pascm_show_func (struct ui_file *file, int from_tty,
 {
   param_smob *p_smob = (param_smob *) get_cmd_context (c);
   SCM value_scm, self, result, exception;
-  char *msg;
-  struct cleanup *cleanups;
 
   gdb_assert (gdbscm_is_procedure (p_smob->show_func));
 
@@ -338,16 +333,15 @@ pascm_show_func (struct ui_file *file, int from_tty,
 				  _("Error occurred showing parameter."));
     }
 
-  msg = gdbscm_scm_to_host_string (result, NULL, &exception);
+  gdb::unique_xmalloc_ptr<char> msg = gdbscm_scm_to_host_string (result, NULL,
+								 &exception);
   if (msg == NULL)
     {
       gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
       error (_("Error converting show text to host string."));
     }
 
-  cleanups = make_cleanup (xfree, msg);
-  fprintf_filtered (file, "%s\n", msg);
-  do_cleanups (cleanups);
+  fprintf_filtered (file, "%s\n", msg.get ());
 }
 
 /* A helper function that dispatches to the appropriate add_setshow
@@ -516,7 +510,8 @@ compute_enum_list (SCM enum_values_scm, int arg_pos, const char *func_name)
 	  freeargv (enum_values);
 	  SCM_ASSERT_TYPE (0, value, arg_pos, func_name, _("string"));
 	}
-      enum_values[i] = gdbscm_scm_to_host_string (value, NULL, &exception);
+      enum_values[i] = gdbscm_scm_to_host_string (value, NULL,
+						  &exception).release ();
       if (enum_values[i] == NULL)
 	{
 	  freeargv (enum_values);
@@ -683,34 +678,33 @@ pascm_set_param_value_x (enum var_types type, union pascm_variable *var,
 	}
       else
 	{
-	  char *string;
 	  SCM exception;
 
-	  string = gdbscm_scm_to_host_string (value, NULL, &exception);
+	  gdb::unique_xmalloc_ptr<char> string
+	    = gdbscm_scm_to_host_string (value, NULL, &exception);
 	  if (string == NULL)
 	    gdbscm_throw (exception);
 	  xfree (var->stringval);
-	  var->stringval = string;
+	  var->stringval = string.release ();
 	}
       break;
 
     case var_enum:
       {
 	int i;
-	char *str;
 	SCM exception;
 
 	SCM_ASSERT_TYPE (scm_is_string (value), value, arg_pos, func_name,
 		       _("string"));
-	str = gdbscm_scm_to_host_string (value, NULL, &exception);
+	gdb::unique_xmalloc_ptr<char> str
+	  = gdbscm_scm_to_host_string (value, NULL, &exception);
 	if (str == NULL)
 	  gdbscm_throw (exception);
 	for (i = 0; enumeration[i]; ++i)
 	  {
-	    if (strcmp (enumeration[i], str) == 0)
+	    if (strcmp (enumeration[i], str.get ()) == 0)
 	      break;
 	  }
-	xfree (str);
 	if (enumeration[i] == NULL)
 	  {
 	    gdbscm_out_of_range_error (func_name, arg_pos, value,
@@ -1059,17 +1053,17 @@ gdbscm_parameter_value (SCM self)
     }
   else
     {
-      char *name;
       SCM except_scm;
       struct cmd_list_element *alias, *prefix, *cmd;
       char *newarg;
       int found = -1;
       struct gdb_exception except = exception_none;
 
-      name = gdbscm_scm_to_host_string (self, NULL, &except_scm);
+      gdb::unique_xmalloc_ptr<char> name
+	= gdbscm_scm_to_host_string (self, NULL, &except_scm);
       if (name == NULL)
 	gdbscm_throw (except_scm);
-      newarg = concat ("show ", name, (char *) NULL);
+      newarg = concat ("show ", name.get (), (char *) NULL);
       TRY
 	{
 	  found = lookup_cmd_composition (newarg, &alias, &prefix, &cmd);
@@ -1080,7 +1074,6 @@ gdbscm_parameter_value (SCM self)
 	}
       END_CATCH
 
-      xfree (name);
       xfree (newarg);
       GDBSCM_HANDLE_GDB_EXCEPTION (except);
       if (!found)
diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c
index eea524b104..f406c1f812 100644
--- a/gdb/guile/scm-pretty-print.c
+++ b/gdb/guile/scm-pretty-print.c
@@ -668,18 +668,16 @@ ppscm_print_string_repr (SCM printer, enum display_hint hint,
     }
   else if (scm_is_string (str_scm))
     {
-      struct cleanup *cleanup;
       size_t length;
-      char *string
+      gdb::unique_xmalloc_ptr<char> string
 	= gdbscm_scm_to_string (str_scm, &length,
 				target_charset (gdbarch), 0 /*!strict*/, NULL);
 
-      cleanup = make_cleanup (xfree, string);
       if (hint == HINT_STRING)
 	{
 	  struct type *type = builtin_type (gdbarch)->builtin_char;
 	  
-	  LA_PRINT_STRING (stream, type, (gdb_byte *) string,
+	  LA_PRINT_STRING (stream, type, (gdb_byte *) string.get (),
 			   length, NULL, 0, options);
 	}
       else
@@ -690,14 +688,13 @@ ppscm_print_string_repr (SCM printer, enum display_hint hint,
 
 	  for (i = 0; i < length; ++i)
 	    {
-	      if (string[i] == '\0')
+	      if (string.get ()[i] == '\0')
 		fputs_filtered ("\\000", stream);
 	      else
-		fputc_filtered (string[i], stream);
+		fputc_filtered (string.get ()[i], stream);
 	    }
 	}
       result = STRING_REPR_OK;
-      do_cleanups (cleanup);
     }
   else if (lsscm_is_lazy_string (str_scm))
     {
diff --git a/gdb/guile/scm-string.c b/gdb/guile/scm-string.c
index 63c60f068a..56e14c3320 100644
--- a/gdb/guile/scm-string.c
+++ b/gdb/guile/scm-string.c
@@ -113,10 +113,9 @@ gdbscm_call_scm_to_stringn (void *datap)
    If STRICT is zero, then escape sequences are used for characters that
    can't be converted, and EXCEPT_SCMP may be passed as NULL.
 
-   Space for the result is allocated with malloc, caller must free.
    It is an error to call this if STRING is not a string.  */
 
-char *
+gdb::unique_xmalloc_ptr<char>
 gdbscm_scm_to_string (SCM string, size_t *lenp,
 		      const char *charset, int strict, SCM *except_scmp)
 {
@@ -136,7 +135,7 @@ gdbscm_scm_to_string (SCM string, size_t *lenp,
   if (gdbscm_is_false (scm_result))
     {
       gdb_assert (data.result != NULL);
-      return data.result;
+      return gdb::unique_xmalloc_ptr<char> (data.result);
     }
   gdb_assert (gdbscm_is_exception (scm_result));
   *except_scmp = scm_result;
@@ -214,10 +213,9 @@ gdbscm_scm_from_string (const char *string, size_t len,
 
    Returns NULL if there is a conversion error, with the exception object
    stored in *EXCEPT_SCMP.
-   Space for the result is allocated with malloc, caller must free.
    It is an error to call this if STRING is not a string.  */
 
-char *
+gdb::unique_xmalloc_ptr<char>
 gdbscm_scm_to_host_string (SCM string, size_t *lenp, SCM *except_scmp)
 {
   return gdbscm_scm_to_string (string, lenp, host_charset (), 1, except_scmp);
-- 
2.13.6

Re: [RFA 0/4] some simple cleanup removal in guile

[Tom Tromey]

>>>>> "Tom" == Tom Tromey <tom@tromey.com> writes:

Tom> This series removes cleanups from a few spots in the guile directory.
Tom> It only removes things that I considered fairly straightforward.

Tom> Tested by the buildbot.

Ping.

Tom

Re: [RFA 0/4] some simple cleanup removal in guile

[Tom Tromey]

>>>>> "Tom" == Tom Tromey <tom@tromey.com> writes:

>>>>> "Tom" == Tom Tromey <tom@tromey.com> writes:
Tom> This series removes cleanups from a few spots in the guile directory.
Tom> It only removes things that I considered fairly straightforward.

Tom> Tested by the buildbot.

Tom> Ping.

Ping.

Tom

Re: [RFA 3/4] Return unique_xmalloc_ptr from gdbscm_safe_eval_string

[Pedro Alves]

On 05/27/2018 04:20 PM, Tom Tromey wrote:

> --- a/gdb/guile/guile-internal.h
> +++ b/gdb/guile/guile-internal.h
> @@ -402,7 +402,8 @@ extern SCM gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM args,
>  
>  extern SCM gdbscm_unsafe_call_1 (SCM proc, SCM arg0);
>  
> -extern char *gdbscm_safe_eval_string (const char *string, int display_result);
> +extern gdb::unique_xmalloc_ptr<char> gdbscm_safe_eval_string
> +    (const char *string, int display_result);

Two spaces.

Otherwise OK.

Thanks,
Pedro Alves

Re: [RFA 2/4] Change gdbscm_exception_message_to_string to return a unique_xmalloc_ptr

[Pedro Alves]

On 05/27/2018 04:20 PM, Tom Tromey wrote:

> ChangeLog
> 2018-05-26  Tom Tromey  <tom@tromey.com>
> 
> 	* guile/scm-param.c (pascm_signal_setshow_error): Update.
> 	* guile/guile-internal.h (gdbscm_exception_message_to_string):
> 	Update.
> 	* guile/scm-cmd.c (cmdscm_function): Update.
> 	* guile/scm-pretty-print.c
> 	(ppscm_print_exception_unless_memory_error): Update.
> 	* guile/scm-exception.c (gdbscm_exception_message_to_string):
> 	Return unique_xmalloc_ptr.

OK.

> @@ -601,9 +598,9 @@ gdbscm_exception_message_to_string (SCM exception)
>      }
>  
>    gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
> -  result = gdbscm_scm_to_c_string (scm_get_output_string (port));
> +  gdb::unique_xmalloc_ptr<char> result
> +    (gdbscm_scm_to_c_string (scm_get_output_string (port)));
>    scm_close_port (port);
> -
>    return result;
>  }

Did you try making gdbscm_scm_to_c_string return a unique_ptr too?

Thanks,
Pedro Alves

Re: [RFA 1/4] Use std::string in ppscm_make_pp_type_error_exception

[Pedro Alves]

On 05/27/2018 04:20 PM, Tom Tromey wrote:
> This changes ppscm_make_pp_type_error_exception to use std::string,
> removing a cleanup.
> 
> ChangeLog
> 2018-05-26  Tom Tromey  <tom@tromey.com>
> 
> 	* guile/scm-pretty-print.c (ppscm_make_pp_type_error_exception):
> 	Use string_printf.

OK.

Thanks,
Pedro Alves

Re: [RFA 4/4] Return unique_xmalloc_ptr from gdbscm_scm_to_string

[Pedro Alves]

On 05/27/2018 04:20 PM, Tom Tromey wrote:

> diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
> index 2bf0cf72b2..7289d25cf1 100644
> --- a/gdb/guile/guile-internal.h
> +++ b/gdb/guile/guile-internal.h
> @@ -526,14 +526,14 @@ extern SCM gdbscm_scm_from_c_string (const char *string);
>  extern SCM gdbscm_scm_from_printf (const char *format, ...)
>      ATTRIBUTE_PRINTF (1, 2);
>  
> -extern char *gdbscm_scm_to_string (SCM string, size_t *lenp,
> -				   const char *charset,
> -				   int strict, SCM *except_scmp);
> +extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_string
> +    (SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp);

Two spaces.

>  
>  extern SCM gdbscm_scm_from_string (const char *string, size_t len,
>  				   const char *charset, int strict);
>  
> -extern char *gdbscm_scm_to_host_string (SCM string, size_t *lenp, SCM *except);
> +extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_host_string
> +    (SCM string, size_t *lenp, SCM *except);

Ditto.

Otherwise OK.

Thanks,
Pedro Alves

Re: [RFA 2/4] Change gdbscm_exception_message_to_string to return a unique_xmalloc_ptr

[Tom Tromey]

>>>>> "Pedro" == Pedro Alves <palves@redhat.com> writes:

>> gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
>> -  result = gdbscm_scm_to_c_string (scm_get_output_string (port));
>> +  gdb::unique_xmalloc_ptr<char> result
>> +    (gdbscm_scm_to_c_string (scm_get_output_string (port)));
>> scm_close_port (port);
>> -
>> return result;
>> }

Pedro> Did you try making gdbscm_scm_to_c_string return a unique_ptr too?

Yes, but this runs into the use of
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS in (at least) gdbscm_value_field.
I haven't looked into what to do about this.

Tom

[RFC] gdbscm_wrap, eliminate GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (Re: [RFA 2/4] Change gdbscm_exception_message_to_string to return a unique_xmalloc_ptr)

[Pedro Alves]

On 07/17/2018 08:10 PM, Tom Tromey wrote:
>>>>>> "Pedro" == Pedro Alves <palves@redhat.com> writes:
> 
>>> gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
>>> -  result = gdbscm_scm_to_c_string (scm_get_output_string (port));
>>> +  gdb::unique_xmalloc_ptr<char> result
>>> +    (gdbscm_scm_to_c_string (scm_get_output_string (port)));
>>> scm_close_port (port);
>>> -
>>> return result;
>>> }
> 
> Pedro> Did you try making gdbscm_scm_to_c_string return a unique_ptr too?
> 
> Yes, but this runs into the use of
> GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS in (at least) gdbscm_value_field.
> I haven't looked into what to do about this.

I gave this a try today.  How about this?

The main issue 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 Guile 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 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.

I converted a few functions that were using 
GDBSCM_HANDLE_GDB_EXCEPTION to use gdbscm_wrap too because
they followed a similar pattern.

You'll notice that 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.  There's
one case like that that I did not fix here, both a cleanup
and a std::string in  gdbscm_execute_gdb_command.

There are only a handful of cleanups in gdb/guile/ after this:

 $ grep make_cleanup *
 guile.c:  cleanups = make_cleanup (xfree, command);
 scm-pretty-print.c:  cleanups = make_cleanup (null_cleanup, NULL);
 scm-pretty-print.c:      struct cleanup *inner_cleanup = make_cleanup (null_cleanup, NULL);
 scm-pretty-print.c:      make_cleanup (xfree, name);
 scm-pretty-print.c:  cleanups = make_cleanup (null_cleanup, NULL);
 scm-value.c:      struct cleanup *cleanups = make_cleanup (xfree, field);

WDYT?  Passes gdb.guile/*.exp here.

From 61aa83947adda43af7edf560b231884311841a84 Mon Sep 17 00:00:00 2001
From: Pedro Alves <palves@redhat.com>
Date: Wed, 18 Jul 2018 14:08:08 +0100
Subject: [PATCH] gdbscm_wrap, eliminate
 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS

This eliminates most remaining cleanups under gdb/guile/.
---
 gdb/guile/guile-internal.h |  41 +++--
 gdb/guile/scm-frame.c      |   4 +-
 gdb/guile/scm-math.c       | 374 +++++++++++++++++--------------------
 gdb/guile/scm-symbol.c     |  17 +-
 gdb/guile/scm-type.c       |  16 +-
 gdb/guile/scm-value.c      | 445 +++++++++++++--------------------------------
 6 files changed, 340 insertions(+), 557 deletions(-)

diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
index 0ef114ac501..0983c06452c 100644
--- a/gdb/guile/guile-internal.h
+++ b/gdb/guile/guile-internal.h
@@ -651,16 +651,35 @@ extern void gdbscm_initialize_values (void);
       }							\
   } while (0)
 
-/* If cleanups are establish outside the TRY_CATCH block, use this version.  */
-
-#define GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS(exception, cleanups)	\
-  do {									\
-    if (exception.reason < 0)						\
-      {									\
-	do_cleanups (cleanups);						\
-	gdbscm_throw_gdb_exception (exception);				\
-        /*NOTREACHED */							\
-      }									\
-  } while (0)
+/* 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 is 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.  */
+
+template<typename Function, typename... Args>
+SCM
+gdbscm_wrap (Function &&func, Args... args)
+{
+  SCM result = SCM_BOOL_F;
+
+  TRY
+    {
+      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 */
diff --git a/gdb/guile/scm-frame.c b/gdb/guile/scm-frame.c
index 7b539677ffd..5894a07c5b8 100644
--- a/gdb/guile/scm-frame.c
+++ b/gdb/guile/scm-frame.c
@@ -783,13 +783,11 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
   char *register_str;
   struct value *value = NULL;
   struct frame_info *frame = NULL;
-  struct cleanup *cleanup;
   frame_smob *f_smob;
 
   f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
 			      register_scm, &register_str);
-  cleanup = make_cleanup (xfree, register_str);
 
   TRY
     {
@@ -811,7 +809,7 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
     }
   END_CATCH
 
-  do_cleanups (cleanup);
+  xfree (register_str);
 
   if (frame == NULL)
     {
diff --git a/gdb/guile/scm-math.c b/gdb/guile/scm-math.c
index 5507dd7d897..74d50754a47 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 <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");
-	}
-    }
-  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
+	 <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");
     }
-  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) -> <gdb:value> */
@@ -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 <gdb:value> 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
diff --git a/gdb/guile/scm-symbol.c b/gdb/guile/scm-symbol.c
index 88027067a30..8495ca5b0a3 100644
--- a/gdb/guile/scm-symbol.c
+++ b/gdb/guile/scm-symbol.c
@@ -582,16 +582,12 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
   int block_arg_pos = -1, domain_arg_pos = -1;
   struct field_of_this_result is_a_field_of_this;
   struct symbol *symbol = NULL;
-  struct cleanup *cleanups;
-  struct gdb_exception except = exception_none;
 
   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
 			      name_scm, &name, rest,
 			      &block_arg_pos, &block_scm,
 			      &domain_arg_pos, &domain);
 
-  cleanups = make_cleanup (xfree, name);
-
   if (block_arg_pos >= 0)
     {
       SCM except_scm;
@@ -600,7 +596,7 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
 				  &except_scm);
       if (block == NULL)
 	{
-	  do_cleanups (cleanups);
+	  xfree (name);
 	  gdbscm_throw (except_scm);
 	}
     }
@@ -615,11 +611,13 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
 	}
       CATCH (except, RETURN_MASK_ALL)
 	{
-	  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+	  xfree (name);
+	  GDBSCM_HANDLE_GDB_EXCEPTION (except);
 	}
       END_CATCH
     }
 
+  struct gdb_exception except = exception_none;
   TRY
     {
       symbol = lookup_symbol (name, block, (domain_enum) domain,
@@ -631,7 +629,7 @@ gdbscm_lookup_symbol (SCM name_scm, SCM rest)
     }
   END_CATCH
 
-  do_cleanups (cleanups);
+  xfree (name);
   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 
   if (symbol == NULL)
@@ -652,15 +650,12 @@ gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
   int domain_arg_pos = -1;
   int domain = VAR_DOMAIN;
   struct symbol *symbol = NULL;
-  struct cleanup *cleanups;
   struct gdb_exception except = exception_none;
 
   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
 			      name_scm, &name, rest,
 			      &domain_arg_pos, &domain);
 
-  cleanups = make_cleanup (xfree, name);
-
   TRY
     {
       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
 
-  do_cleanups (cleanups);
+  xfree (name);
   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 
   if (symbol == NULL)
diff --git a/gdb/guile/scm-type.c b/gdb/guile/scm-type.c
index cc997563dab..5c4490d5ffc 100644
--- a/gdb/guile/scm-type.c
+++ b/gdb/guile/scm-type.c
@@ -977,7 +977,6 @@ gdbscm_type_field (SCM self, SCM field_scm)
   struct type *type = t_smob->type;
   char *field;
   int i;
-  struct cleanup *cleanups;
 
   SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
 		   _("string"));
@@ -992,7 +991,6 @@ gdbscm_type_field (SCM self, SCM field_scm)
 			       _(not_composite_error));
 
   field = gdbscm_scm_to_c_string (field_scm);
-  cleanups = make_cleanup (xfree, field);
 
   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))
 	{
-	    do_cleanups (cleanups);
-	    return tyscm_make_field_smob (self, i);
+	  xfree (field);
+	  return tyscm_make_field_smob (self, i);
 	}
     }
 
-  do_cleanups (cleanups);
+  xfree (field);
 
   gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm,
 			     _("Unknown field"));
@@ -1022,7 +1020,6 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
   struct type *type = t_smob->type;
   char *field;
   int i;
-  struct cleanup *cleanups;
 
   SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
 		   _("string"));
@@ -1037,7 +1034,6 @@ gdbscm_type_has_field_p (SCM self, SCM field_scm)
 			       _(not_composite_error));
 
   field = gdbscm_scm_to_c_string (field_scm);
-  cleanups = make_cleanup (xfree, field);
 
   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))
 	{
-	    do_cleanups (cleanups);
-	    return SCM_BOOL_T;
+	  xfree (field);
+	  return SCM_BOOL_T;
 	}
     }
 
-  do_cleanups (cleanups);
+  xfree (field);
 
   return SCM_BOOL_F;
 }
diff --git a/gdb/guile/scm-value.c b/gdb/guile/scm-value.c
index fccddfec413..c2938643756 100644
--- a/gdb/guile/scm-value.c
+++ b/gdb/guile/scm-value.c
@@ -303,46 +303,38 @@ vlscm_scm_to_value (SCM 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);
-    }
+						 get_current_arch (),
+						 current_language);
+      if (value == NULL)
+	return except_scm;
 
-  result = vlscm_scm_from_value (value);
-
-  do_cleanups (cleanups);
-
-  if (gdbscm_is_exception (result))
-    gdbscm_throw (result);
-  return result;
+      return vlscm_scm_from_value (value);
+    });
 }
 
 /* (make-lazy-value <gdb:type> address) -> <gdb:value> */
@@ -350,40 +342,22 @@ gdbscm_make_value (SCM x, SCM rest)
 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);
+      scoped_value_mark free_values;
 
-  do_cleanups (cleanups);
-
-  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 */
@@ -393,20 +367,11 @@ gdbscm_value_optimized_out_p (SCM self)
 {
   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
-    {
-      opt = value_optimized_out (value);
-    }
-  CATCH (except, RETURN_MASK_ALL)
+  return gdbscm_wrap ([=]
     {
-      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
@@ -419,30 +384,31 @@ gdbscm_value_address (SCM self)
     = 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 cleanup *cleanup
-	= make_cleanup_value_free_to_mark (value_mark ());
-      SCM address = SCM_BOOL_F;
-
-      TRY
+      if (SCM_UNBNDP (v_smob->address))
 	{
-	  address = vlscm_scm_from_value (value_addr (value));
-	}
-      CATCH (except, RETURN_MASK_ALL)
-	{
-	}
-      END_CATCH
+	  scoped_value_mark free_values;
 
-      do_cleanups (cleanup);
+	  SCM address = SCM_BOOL_F;
 
-      if (gdbscm_is_exception (address))
-	gdbscm_throw (address);
+	  TRY
+	    {
+	      address = vlscm_scm_from_value (value_addr (value));
+	    }
+	  CATCH (except, RETURN_MASK_ALL)
+	    {
+	    }
+	  END_CATCH
 
-      v_smob->address = address;
-    }
+	  if (gdbscm_is_exception (address))
+	    return address;
+
+	  v_smob->address = address;
+	}
 
-  return v_smob->address;
+      return v_smob->address;
+    });
 }
 
 /* (value-dereference <gdb:value>) -> <gdb:value>
@@ -453,31 +419,14 @@ gdbscm_value_dereference (SCM self)
 {
   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 ([=]
     {
-      res_val = value_ind (value);
-    }
-  CATCH (except, RETURN_MASK_ALL)
-    {
-      GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
-    }
-  END_CATCH
+      scoped_value_mark free_values;
 
-  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_ind (v_smob->value);
+      return vlscm_scm_from_value (res_val);
+    });
 }
 
 /* (value-referenced-value <gdb:value>) -> <gdb:value>
@@ -495,14 +444,13 @@ gdbscm_value_referenced_value (SCM self)
   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:
@@ -515,21 +463,9 @@ gdbscm_value_referenced_value (SCM self)
           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> */
@@ -562,8 +498,7 @@ gdbscm_value_dynamic_type (SCM self)
 
   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);
@@ -596,8 +531,6 @@ gdbscm_value_dynamic_type (SCM self)
 	  /* Re-use object's static type.  */
 	  type = NULL;
 	}
-
-      do_cleanups (cleanup);
     }
   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
     = 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)
@@ -642,22 +573,9 @@ vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
 	  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> */
@@ -693,42 +611,29 @@ gdbscm_value_field (SCM self, SCM field_scm)
 {
   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 ());
+  return gdbscm_wrap ([=]
+    {
+      scoped_value_mark free_values;
 
-  field = gdbscm_scm_to_c_string (field_scm);
-  make_cleanup (xfree, field);
+      char *field = gdbscm_scm_to_c_string (field_scm);
 
-  TRY
-    {
-      struct value *tmp = value;
+      struct cleanup *cleanups = make_cleanup (xfree, field);
 
-      res_val = value_struct_elt (&tmp, NULL, field, NULL,
-				  "struct/class/union");
-    }
-  CATCH (except, RETURN_MASK_ALL)
-    {
-      GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
-    }
-  END_CATCH
+      struct value *tmp = v_smob->value;
 
-  gdb_assert (res_val != NULL);
-  result = vlscm_scm_from_value (res_val);
+      struct value *res_val = value_struct_elt (&tmp, NULL, field, NULL,
+						"struct/class/union");
 
-  do_cleanups (cleanups);
+      SCM result = vlscm_scm_from_value (res_val);
 
-  if (gdbscm_is_exception (result))
-    gdbscm_throw (result);
+      do_cleanups (cleanups);
 
-  return result;
+      return result;
+    });
 }
 
 /* (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
     = 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>
@@ -854,25 +734,14 @@ gdbscm_value_call (SCM self, SCM args)
       gdb_assert (gdbscm_is_true (scm_null_p (args)));
     }
 
-  TRY
+  return gdbscm_wrap ([=]
     {
-      struct cleanup *cleanup = make_cleanup_value_free_to_mark (mark);
-      struct value *return_value;
+      scoped_value_mark free_values;
 
-      return_value = call_function_by_hand (function, NULL, args_count, vargs);
-      result = vlscm_scm_from_value (return_value);
-      do_cleanups (cleanup);
-    }
-  CATCH (except, RETURN_MASK_ALL)
-    {
-      GDBSCM_HANDLE_GDB_EXCEPTION (except);
-    }
-  END_CATCH
-
-  if (gdbscm_is_exception (result))
-    gdbscm_throw (result);
-
-  return result;
+      value *return_value = call_function_by_hand (function, NULL,
+						   args_count, vargs);
+      return vlscm_scm_from_value (return_value);
+    });
 }
 
 /* (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;
   char *encoding = NULL;
   SCM errors = SCM_BOOL_F;
+  gdb_byte *buffer_contents;
   int length = -1;
-  gdb::unique_xmalloc_ptr<gdb_byte> buffer;
   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.  */
@@ -1120,8 +988,6 @@ gdbscm_value_to_string (SCM self, SCM rest)
 			      &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)
@@ -1131,7 +997,7 @@ gdbscm_value_to_string (SCM self, SCM rest)
 	= 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)
@@ -1148,22 +1014,23 @@ gdbscm_value_to_string (SCM self, SCM rest)
 
   TRY
     {
+      gdb::unique_xmalloc_ptr<gdb_byte> buffer;
       LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
+      buffer_contents = buffer.release ();
     }
   CATCH (except, RETURN_MASK_ALL)
     {
-      GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+      xfree (encoding);
+      GDBSCM_HANDLE_GDB_EXCEPTION (except);
     }
   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.  */
-  discard_cleanups (cleanups);
 
   scm_dynwind_begin ((scm_t_dynwind_flags) 0);
 
   gdbscm_dynwind_xfree (encoding);
-  gdb_byte *buffer_contents = buffer.release ();
   gdbscm_dynwind_xfree (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;
   int length = -1;
   SCM result = SCM_BOOL_F; /* -Wall */
-  struct cleanup *cleanups;
   struct gdb_exception except = exception_none;
 
   /* The sequencing here, as everywhere else, is important.
@@ -1219,12 +1085,10 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
 				 _("invalid length"));
     }
 
-  cleanups = make_cleanup (xfree, encoding);
-
   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;
 
@@ -1275,8 +1139,6 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
 	}
 
       result = lsscm_make_lazy_string (addr, length, encoding, type);
-
-      do_cleanups (inner_cleanup);
     }
   CATCH (ex, RETURN_MASK_ALL)
     {
@@ -1284,7 +1146,7 @@ gdbscm_value_to_lazy_string (SCM self, SCM rest)
     }
   END_CATCH
 
-  do_cleanups (cleanups);
+  xfree (encoding);
   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 
   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);
   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 */
@@ -1369,38 +1225,14 @@ static SCM
 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
-    {
-      res_val = parse_and_eval (expr_str);
-    }
-  CATCH (except, RETURN_MASK_ALL)
+  return gdbscm_wrap ([=]
     {
-      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>
@@ -1410,21 +1242,12 @@ static SCM
 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
+  return gdbscm_wrap ([=]
     {
-      res_val = access_value_history (i);
-    }
-  CATCH (except, RETURN_MASK_ALL)
-    {
-      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
@@ -1433,24 +1256,12 @@ gdbscm_history_ref (SCM 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.  */
-- 
2.14.4

Re: [RFC] gdbscm_wrap, eliminate GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (Re: [RFA 2/4] Change gdbscm_exception_message_to_string to return a unique_xmalloc_ptr)

[Tom Tromey]

>>>>> "Pedro" == Pedro Alves <palves@redhat.com> writes:

Pedro> I gave this a try today.  How about this?

Pedro> +/* Use this to wrap a callable to throw the appropriate Scheme
Pedro> +   exception if the callable throws a GDB error.  ARGS are forwarded
Pedro> +   to FUNC.  Returns the result of FUNC, unless FUNC returns a Scheme
Pedro> +   exception, in which case that exception is thrown.  Note that while
Pedro> +   the callable is free is use objects of types with destructors,

Typo - "free to use objects".

Pedro> +++ b/gdb/guile/scm-frame.c
Pedro> @@ -783,13 +783,11 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
Pedro>    char *register_str;
Pedro>    struct value *value = NULL;
Pedro>    struct frame_info *frame = NULL;
Pedro> -  struct cleanup *cleanup;
Pedro>    frame_smob *f_smob;
 
Pedro>    f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
Pedro>    gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
Pedro>  			      register_scm, &register_str);
Pedro> -  cleanup = make_cleanup (xfree, register_str);
 
Pedro>    TRY
Pedro>      {
Pedro> @@ -811,7 +809,7 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
Pedro>      }
Pedro>    END_CATCH
 
Pedro> -  do_cleanups (cleanup);
Pedro> +  xfree (register_str);

I think this will leak register_str if anything throws.  Maybe the xfree
should be duplicated in the catch block, or maybe the whole try/catch
should be replaced with a call to gdbscm_wrap (where the callback would
take ownership of register_str).

This seems like a latent bug here as well - I think the code should be using
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS here.


Otherwise this all looks good to me.  Thanks for doing this, guile was
one of the larger cleanup holdouts

Tom

Re: [RFC] gdbscm_wrap, eliminate GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (Re: [RFA 2/4] Change gdbscm_exception_message_to_string to return a unique_xmalloc_ptr)

[Pedro Alves]

On 07/18/2018 08:33 PM, Tom Tromey wrote:
>>>>>> "Pedro" == Pedro Alves <palves@redhat.com> writes:
> 
> Pedro> I gave this a try today.  How about this?
> 
> Pedro> +/* Use this to wrap a callable to throw the appropriate Scheme
> Pedro> +   exception if the callable throws a GDB error.  ARGS are forwarded
> Pedro> +   to FUNC.  Returns the result of FUNC, unless FUNC returns a Scheme
> Pedro> +   exception, in which case that exception is thrown.  Note that while
> Pedro> +   the callable is free is use objects of types with destructors,
> 
> Typo - "free to use objects".

Thanks, fixed.

> 
> Pedro> +++ b/gdb/guile/scm-frame.c
> Pedro> @@ -783,13 +783,11 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
> Pedro>    char *register_str;
> Pedro>    struct value *value = NULL;
> Pedro>    struct frame_info *frame = NULL;
> Pedro> -  struct cleanup *cleanup;
> Pedro>    frame_smob *f_smob;
>  
> Pedro>    f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
> Pedro>    gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
> Pedro>  			      register_scm, &register_str);
> Pedro> -  cleanup = make_cleanup (xfree, register_str);
>  
> Pedro>    TRY
> Pedro>      {
> Pedro> @@ -811,7 +809,7 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
> Pedro>      }
> Pedro>    END_CATCH
>  
> Pedro> -  do_cleanups (cleanup);
> Pedro> +  xfree (register_str);
> 
> I think this will leak register_str if anything throws.  Maybe the xfree
> should be duplicated in the catch block, or maybe the whole try/catch
> should be replaced with a call to gdbscm_wrap (where the callback would
> take ownership of register_str).
> 
> This seems like a latent bug here as well - I think the code should be using
> GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS here.
> 

Indeed.  I fixed this using the same pattern used elsewhere, of saving
the exception object in the CATCH block:

--- c/gdb/guile/scm-frame.c
+++ w/gdb/guile/scm-frame.c
@@ -783,13 +783,13 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
   char *register_str;
   struct value *value = NULL;
   struct frame_info *frame = NULL;
-  struct cleanup *cleanup;
   frame_smob *f_smob;
 
   f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
                              register_scm, &register_str);
-  cleanup = make_cleanup (xfree, register_str);
+
+  struct gdb_exception except = exception_none;
 
   TRY
     {
@@ -805,13 +805,14 @@ gdbscm_frame_read_register (SCM self, SCM register_scm)
            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
 
-  do_cleanups (cleanup);
+  xfree (register_str);
+  GDBSCM_HANDLE_GDB_EXCEPTION (except);
 
   if (frame == NULL)
     {

> Otherwise this all looks good to me.  Thanks for doing this, guile was
> one of the larger cleanup holdouts

Great.  I wrote a ChangeLog entry and pushed it in:
 https://sourceware.org/ml/gdb-patches/2018-07/msg00567.html

The only other change is that I copied the first paragraph of
the commit log to guile/guile-internal.h.

Thanks,
Pedro Alves