示例#1
0
文件: guile.c 项目: nadeaud/ROCm-GDB
static SCM
gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
{
  int from_tty_arg_pos = -1, to_string_arg_pos = -1;
  int from_tty = 0, to_string = 0;
  volatile struct gdb_exception except;
  const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
  char *command;
  char *result = NULL;
  struct cleanup *cleanups;

  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
			      command_scm, &command, rest,
			      &from_tty_arg_pos, &from_tty,
			      &to_string_arg_pos, &to_string);

  /* Note: The contents of "command" may get modified while it is
     executed.  */
  cleanups = make_cleanup (xfree, command);

  TRY_CATCH (except, RETURN_MASK_ALL)
    {
      struct cleanup *inner_cleanups;

      inner_cleanups = make_cleanup_restore_integer (&interpreter_async);
      interpreter_async = 0;

      prevent_dont_repeat ();
      if (to_string)
	result = execute_command_to_string (command, from_tty);
      else
	{
	  execute_command (command, from_tty);
	  result = NULL;
	}

      /* Do any commands attached to breakpoint we stopped at.  */
      bpstat_do_actions ();

      do_cleanups (inner_cleanups);
    }
  do_cleanups (cleanups);
  GDBSCM_HANDLE_GDB_EXCEPTION (except);

  if (result)
    {
      SCM r = gdbscm_scm_from_c_string (result);
      xfree (result);
      return r;
    }
  return SCM_UNSPECIFIED;
}
示例#2
0
static SCM
gdbscm_delete_breakpoint_x (SCM self)
{
  breakpoint_smob *bp_smob
    = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);

  TRY
    {
      delete_breakpoint (bp_smob->bp);
    }
  CATCH (except, RETURN_MASK_ALL)
    {
      GDBSCM_HANDLE_GDB_EXCEPTION (except);
    }
示例#3
0
static SCM
gdbscm_frame_valid_p (SCM self)
{
    frame_smob *f_smob;
    struct frame_info *frame = NULL;

    f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);

    TRY
    {
        frame = frscm_frame_smob_to_frame (f_smob);
    }
    CATCH (except, RETURN_MASK_ALL)
    {
        GDBSCM_HANDLE_GDB_EXCEPTION (except);
    }
示例#4
0
static SCM
gdbscm_symbol_needs_frame_p (SCM self)
{
  symbol_smob *s_smob
    = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
  struct symbol *symbol = s_smob->symbol;
  int result = 0;

  TRY
    {
      result = symbol_read_needs_frame (symbol);
    }
  CATCH (except, RETURN_MASK_ALL)
    {
      GDBSCM_HANDLE_GDB_EXCEPTION (except);
    }
示例#5
0
static SCM
gdbscm_register_parameter_x (SCM self)
{
  param_smob *p_smob
    = pascm_get_param_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
  char *cmd_name;
  struct cmd_list_element **set_list, **show_list;

  if (pascm_is_valid (p_smob))
    scm_misc_error (FUNC_NAME, _("parameter is already registered"), SCM_EOL);

  cmd_name = gdbscm_parse_command_name (p_smob->name, FUNC_NAME, SCM_ARG1,
					&set_list, &setlist);
  xfree (cmd_name);
  cmd_name = gdbscm_parse_command_name (p_smob->name, FUNC_NAME, SCM_ARG1,
					&show_list, &showlist);
  p_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name);
  xfree (cmd_name);

  if (pascm_parameter_defined_p (p_smob->cmd_name, *set_list))
    {
      gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self,
		_("parameter exists, \"set\" command is already defined"));
    }
  if (pascm_parameter_defined_p (p_smob->cmd_name, *show_list))
    {
      gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self,
		_("parameter exists, \"show\" command is already defined"));
    }

  TRY
    {
      add_setshow_generic (p_smob->type, p_smob->cmd_class,
			   p_smob->cmd_name, p_smob,
			   p_smob->set_doc, p_smob->show_doc, p_smob->doc,
			   (gdbscm_is_procedure (p_smob->set_func)
			    ? pascm_set_func : NULL),
			   (gdbscm_is_procedure (p_smob->show_func)
			    ? pascm_show_func : NULL),
			   set_list, show_list,
			   &p_smob->set_command, &p_smob->show_command);
    }
  CATCH (except, RETURN_MASK_ALL)
    {
      GDBSCM_HANDLE_GDB_EXCEPTION (except);
    }
static void
ioscm_write (SCM port, const void *data, size_t size)
{

  /* If we're called on stdin, punt.  */
  if (scm_is_eq (port, input_port_scm))
    return;

  TRY
    {
      if (scm_is_eq (port, error_port_scm))
	fputsn_filtered ((const char *) data, size, gdb_stderr);
      else
	fputsn_filtered ((const char *) data, size, gdb_stdout);
    }
  CATCH (except, RETURN_MASK_ALL)
    {
      GDBSCM_HANDLE_GDB_EXCEPTION (except);
    }
示例#7
0
static SCM
gdbscm_find_pc_line (SCM pc_scm)
{
  ULONGEST pc_ull;
  struct symtab_and_line sal;

  init_sal (&sal); /* -Wall */

  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc_ull);

  TRY
    {
      CORE_ADDR pc = (CORE_ADDR) pc_ull;

      sal = find_pc_line (pc, 0);
    }
  CATCH (except, RETURN_MASK_ALL)
    {
      GDBSCM_HANDLE_GDB_EXCEPTION (except);
    }
示例#8
0
static SCM
gdbscm_register_breakpoint_x (SCM self)
{
  breakpoint_smob *bp_smob
    = bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
  struct gdb_exception except = exception_none;
  char *location, *copy;
  struct event_location *eloc;
  struct cleanup *cleanup;

  /* We only support registering breakpoints created with make-breakpoint.  */
  if (!bp_smob->is_scheme_bkpt)
    scm_misc_error (FUNC_NAME, _("not a Scheme breakpoint"), SCM_EOL);

  if (bpscm_is_valid (bp_smob))
    scm_misc_error (FUNC_NAME, _("breakpoint is already registered"), SCM_EOL);

  pending_breakpoint_scm = self;
  location = bp_smob->spec.location;
  copy = location;
  eloc = new_linespec_location (&copy);
  cleanup = make_cleanup_delete_event_location (eloc);

  TRY
    {
      int internal = bp_smob->spec.is_internal;

      switch (bp_smob->spec.type)
	{
	case bp_breakpoint:
	  {
	    create_breakpoint (get_current_arch (),
			       eloc, NULL, -1, NULL,
			       0,
			       0, bp_breakpoint,
			       0,
			       AUTO_BOOLEAN_TRUE,
			       &bkpt_breakpoint_ops,
			       0, 1, internal, 0);
	    break;
	  }
	case bp_watchpoint:
	  {
	    enum target_hw_bp_type access_type = bp_smob->spec.access_type;

	    if (access_type == hw_write)
	      watch_command_wrapper (location, 0, internal);
	    else if (access_type == hw_access)
	      awatch_command_wrapper (location, 0, internal);
	    else if (access_type == hw_read)
	      rwatch_command_wrapper (location, 0, internal);
	    else
	      gdb_assert_not_reached ("invalid access type");
	    break;
	  }
	default:
	  gdb_assert_not_reached ("invalid breakpoint type");
	}
    }
  CATCH (ex, RETURN_MASK_ALL)
    {
      except = ex;
    }
  END_CATCH

  /* Ensure this gets reset, even if there's an error.  */
  pending_breakpoint_scm = SCM_BOOL_F;
  GDBSCM_HANDLE_GDB_EXCEPTION (except);
  do_cleanups (cleanup);

  return SCM_UNSPECIFIED;
}