static SCM gdbscm_string_to_argv (SCM string_scm) { char *string; char **c_argv; int i; SCM result = SCM_EOL; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s", string_scm, &string); if (string == NULL || *string == '\0') { xfree (string); return SCM_EOL; } c_argv = gdb_buildargv (string); for (i = 0; c_argv[i] != NULL; ++i) result = scm_cons (gdbscm_scm_from_c_string (c_argv[i]), result); freeargv (c_argv); xfree (string); return scm_reverse_x (result, SCM_EOL); }
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; }
static SCM gdbscm_open_memory (SCM rest) { const SCM keywords[] = { mode_keyword, start_keyword, size_keyword, SCM_BOOL_F }; char *mode = NULL; CORE_ADDR start = 0; CORE_ADDR end; int mode_arg_pos = -1, start_arg_pos = -1, size_arg_pos = -1; ULONGEST size; SCM port; long mode_bits; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "#sUU", rest, &mode_arg_pos, &mode, &start_arg_pos, &start, &size_arg_pos, &size); scm_dynwind_begin ((scm_t_dynwind_flags) 0); if (mode == NULL) mode = xstrdup ("r"); scm_dynwind_free (mode); if (size_arg_pos > 0) { /* For now be strict about start+size overflowing. If it becomes a nuisance we can relax things later. */ if (start + size < start) { gdbscm_out_of_range_error (FUNC_NAME, 0, scm_list_2 (gdbscm_scm_from_ulongest (start), gdbscm_scm_from_ulongest (size)), _("start+size overflows")); } end = start + size; } else end = ~(CORE_ADDR) 0; mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode); port = ioscm_open_port (memory_port_desc, mode_bits); ioscm_init_memory_port (port, start, end); scm_dynwind_end (); /* TODO: Set the file name as "memory-start-end"? */ return port; }
static SCM gdbscm_find_pc_line (SCM pc_scm) { ULONGEST pc_ull; struct symtab_and_line sal; volatile struct gdb_exception except; init_sal (&sal); /* -Wall */ gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc_ull); TRY_CATCH (except, RETURN_MASK_ALL) { CORE_ADDR pc = (CORE_ADDR) pc_ull; sal = find_pc_line (pc, 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); }
static SCM gdbscm_string_to_argv (SCM string_scm) { char *string; SCM result = SCM_EOL; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s", string_scm, &string); if (string == NULL || *string == '\0') { xfree (string); return SCM_EOL; } gdb_argv c_argv (string); for (char *arg : c_argv) result = scm_cons (gdbscm_scm_from_c_string (arg), result); xfree (string); return scm_reverse_x (result, SCM_EOL); }
static SCM gdbscm_make_breakpoint (SCM location_scm, SCM rest) { const SCM keywords[] = { type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F }; char *s; char *location; int type_arg_pos = -1, access_type_arg_pos = -1, internal_arg_pos = -1; enum bptype type = bp_breakpoint; enum target_hw_bp_type access_type = hw_write; int internal = 0; SCM result; breakpoint_smob *bp_smob; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit", location_scm, &location, rest, &type_arg_pos, &type, &access_type_arg_pos, &access_type, &internal_arg_pos, &internal); result = bpscm_make_breakpoint_smob (); bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result); s = location; location = gdbscm_gc_xstrdup (s); xfree (s); switch (type) { case bp_breakpoint: if (access_type_arg_pos > 0) { gdbscm_misc_error (FUNC_NAME, access_type_arg_pos, scm_from_int (access_type), _("access type with breakpoint is not allowed")); } break; case bp_watchpoint: switch (access_type) { case hw_write: case hw_access: case hw_read: break; default: gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos, scm_from_int (access_type), _("invalid watchpoint class")); } break; default: gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos, scm_from_int (type), _("invalid breakpoint type")); } bp_smob->is_scheme_bkpt = 1; bp_smob->spec.location = location; bp_smob->spec.type = type; bp_smob->spec.access_type = access_type; bp_smob->spec.is_internal = internal; return result; }
static SCM gdbscm_make_parameter (SCM name_scm, SCM rest) { const SCM keywords[] = { command_class_keyword, parameter_type_keyword, enum_list_keyword, set_func_keyword, show_func_keyword, doc_keyword, set_doc_keyword, show_doc_keyword, initial_value_keyword, SCM_BOOL_F }; int cmd_class_arg_pos = -1, param_type_arg_pos = -1; int enum_list_arg_pos = -1, set_func_arg_pos = -1, show_func_arg_pos = -1; int doc_arg_pos = -1, set_doc_arg_pos = -1, show_doc_arg_pos = -1; int initial_value_arg_pos = -1; char *s; char *name; int cmd_class = no_class; int param_type = var_boolean; /* ARI: var_boolean */ SCM enum_list_scm = SCM_BOOL_F; SCM set_func = SCM_BOOL_F, show_func = SCM_BOOL_F; char *doc = NULL, *set_doc = NULL, *show_doc = NULL; SCM initial_value_scm = SCM_BOOL_F; const char * const *enum_list = NULL; SCM p_scm; param_smob *p_smob; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iiOOOsssO", name_scm, &name, rest, &cmd_class_arg_pos, &cmd_class, ¶m_type_arg_pos, ¶m_type, &enum_list_arg_pos, &enum_list_scm, &set_func_arg_pos, &set_func, &show_func_arg_pos, &show_func, &doc_arg_pos, &doc, &set_doc_arg_pos, &set_doc, &show_doc_arg_pos, &show_doc, &initial_value_arg_pos, &initial_value_scm); /* If doc is NULL, leave it NULL. See add_setshow_cmd_full. */ if (set_doc == NULL) set_doc = get_doc_string (); if (show_doc == NULL) show_doc = get_doc_string (); s = name; name = gdbscm_canonicalize_command_name (s, 0); xfree (s); if (doc != NULL) { s = doc; doc = gdbscm_gc_xstrdup (s); xfree (s); } s = set_doc; set_doc = gdbscm_gc_xstrdup (s); xfree (s); s = show_doc; show_doc = gdbscm_gc_xstrdup (s); xfree (s); if (!gdbscm_valid_command_class_p (cmd_class)) { gdbscm_out_of_range_error (FUNC_NAME, cmd_class_arg_pos, scm_from_int (cmd_class), _("invalid command class argument")); } if (!pascm_valid_parameter_type_p (param_type)) { gdbscm_out_of_range_error (FUNC_NAME, param_type_arg_pos, scm_from_int (param_type), _("invalid parameter type argument")); } if (enum_list_arg_pos > 0 && param_type != var_enum) { gdbscm_misc_error (FUNC_NAME, enum_list_arg_pos, enum_list_scm, _("#:enum-values can only be provided with PARAM_ENUM")); } if (enum_list_arg_pos < 0 && param_type == var_enum) { gdbscm_misc_error (FUNC_NAME, GDBSCM_ARG_NONE, SCM_BOOL_F, _("PARAM_ENUM requires an enum-values argument")); } if (set_func_arg_pos > 0) { SCM_ASSERT_TYPE (gdbscm_is_procedure (set_func), set_func, set_func_arg_pos, FUNC_NAME, _("procedure")); } if (show_func_arg_pos > 0) { SCM_ASSERT_TYPE (gdbscm_is_procedure (show_func), show_func, show_func_arg_pos, FUNC_NAME, _("procedure")); } if (param_type == var_enum) { /* Note: enum_list lives in GC space, so we don't have to worry about freeing it if we later throw an exception. */ enum_list = compute_enum_list (enum_list_scm, enum_list_arg_pos, FUNC_NAME); } /* If initial-value is a function, we need the parameter object constructed to pass it to the function. A typical thing the function may want to do is add an object-property to it to record the last known good value. */ p_scm = pascm_make_param_smob (); p_smob = (param_smob *) SCM_SMOB_DATA (p_scm); /* These are all stored in GC space so that we don't have to worry about freeing them if we throw an exception. */ p_smob->name = name; p_smob->cmd_class = (enum command_class) cmd_class; p_smob->type = (enum var_types) param_type; p_smob->doc = doc; p_smob->set_doc = set_doc; p_smob->show_doc = show_doc; p_smob->enumeration = enum_list; p_smob->set_func = set_func; p_smob->show_func = show_func; if (initial_value_arg_pos > 0) { if (gdbscm_is_procedure (initial_value_scm)) { initial_value_scm = gdbscm_safe_call_1 (initial_value_scm, p_smob->containing_scm, NULL); if (gdbscm_is_exception (initial_value_scm)) gdbscm_throw (initial_value_scm); } pascm_set_param_value_x (p_smob->type, &p_smob->value, enum_list, initial_value_scm, initial_value_arg_pos, FUNC_NAME); } return p_scm; }
static SCM gdbscm_arch_disassemble (SCM self, SCM start_scm, SCM rest) { arch_smob *a_smob = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); struct gdbarch *gdbarch = arscm_get_gdbarch (a_smob); const SCM keywords[] = { port_keyword, offset_keyword, size_keyword, count_keyword, SCM_BOOL_F }; int port_arg_pos = -1, offset_arg_pos = -1; int size_arg_pos = -1, count_arg_pos = -1; SCM port = SCM_BOOL_F; ULONGEST offset = 0; unsigned int count = 1; unsigned int size; ULONGEST start_arg; CORE_ADDR start, end; CORE_ADDR pc; unsigned int i; int using_port; SCM result; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "U#OUuu", start_scm, &start_arg, rest, &port_arg_pos, &port, &offset_arg_pos, &offset, &size_arg_pos, &size, &count_arg_pos, &count); /* START is first stored in a ULONGEST because we don't have a format char for CORE_ADDR, and it's not really worth it to have one yet. */ start = start_arg; if (port_arg_pos > 0) { SCM_ASSERT_TYPE (gdbscm_is_false (port) || gdbscm_is_true (scm_input_port_p (port)), port, port_arg_pos, FUNC_NAME, _("input port")); } using_port = gdbscm_is_true (port); if (offset_arg_pos > 0 && (port_arg_pos < 0 || gdbscm_is_false (port))) { gdbscm_out_of_range_error (FUNC_NAME, offset_arg_pos, gdbscm_scm_from_ulongest (offset), _("offset provided but port is missing")); } if (size_arg_pos > 0) { if (size == 0) return SCM_EOL; /* For now be strict about start+size overflowing. If it becomes a nuisance we can relax things later. */ if (start + size < start) { gdbscm_out_of_range_error (FUNC_NAME, 0, scm_list_2 (gdbscm_scm_from_ulongest (start), gdbscm_scm_from_ulongest (size)), _("start+size overflows")); } end = start + size - 1; } else end = ~(CORE_ADDR) 0; if (count == 0) return SCM_EOL; result = SCM_EOL; for (pc = start, i = 0; pc <= end && i < count; ) { int insn_len = 0; struct ui_file *memfile = mem_fileopen (); struct cleanup *cleanups = make_cleanup_ui_file_delete (memfile); TRY { if (using_port) { insn_len = gdbscm_print_insn_from_port (gdbarch, port, offset, pc, memfile, NULL); } else insn_len = gdb_print_insn (gdbarch, pc, memfile, NULL); } CATCH (except, RETURN_MASK_ALL) { GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups); } END_CATCH std::string as = ui_file_as_string (memfile); result = scm_cons (dascm_make_insn (pc, as.c_str (), insn_len), result); pc += insn_len; i++; do_cleanups (cleanups); }