void gdbscm_enter_repl (void) { /* It's unfortunate to have to resort to something like this, but scm_shell doesn't return. :-( I found this code on guile-user@. */ gdbscm_safe_call_1 (scm_c_public_ref ("system repl repl", "start-repl"), scm_from_latin1_symbol ("scheme"), NULL); }
static SCM ppscm_pretty_print_one_value (SCM printer, struct value **out_value, struct gdbarch *gdbarch, const struct language_defn *language) { SCM result = SCM_BOOL_F; *out_value = NULL; TRY { int rc; pretty_printer_worker_smob *w_smob = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer); result = gdbscm_safe_call_1 (w_smob->to_string, printer, gdbscm_memory_error_p); if (gdbscm_is_false (result)) ; /* Done. */ else if (scm_is_string (result) || lsscm_is_lazy_string (result)) ; /* Done. */ else if (vlscm_is_value (result)) { SCM except_scm; *out_value = vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE, result, &except_scm, gdbarch, language); if (*out_value != NULL) result = SCM_BOOL_T; else result = except_scm; } else if (gdbscm_is_exception (result)) ; /* Done. */ else { /* Invalid result from to-string. */ result = ppscm_make_pp_type_error_exception (_("invalid result from pretty-printer to-string"), result); } } CATCH (except, RETURN_MASK_ALL) { } END_CATCH return result; }
static void 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)); self = p_smob->containing_scm; result = gdbscm_safe_call_1 (p_smob->set_func, self, gdbscm_user_error_p); if (gdbscm_is_exception (result)) { pascm_signal_setshow_error (result, _("Error occurred setting parameter.")); } 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); 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); }
static void ppscm_print_children (SCM printer, enum display_hint hint, struct ui_file *stream, int recurse, const struct value_print_options *options, struct gdbarch *gdbarch, const struct language_defn *language, int printed_nothing) { pretty_printer_worker_smob *w_smob = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer); int is_map, is_array, done_flag, pretty; unsigned int i; SCM children, status; SCM iter = SCM_BOOL_F; /* -Wall */ struct cleanup *cleanups; if (gdbscm_is_false (w_smob->children)) return; if (!gdbscm_is_procedure (w_smob->children)) { ppscm_print_pp_type_error (_("pretty-printer \"children\" object is not a procedure or #f"), w_smob->children); return; } cleanups = make_cleanup (null_cleanup, NULL); /* If we are printing a map or an array, we want special formatting. */ is_map = hint == HINT_MAP; is_array = hint == HINT_ARRAY; children = gdbscm_safe_call_1 (w_smob->children, printer, gdbscm_memory_error_p); if (gdbscm_is_exception (children)) { ppscm_print_exception_unless_memory_error (children, stream); goto done; } /* We combine two steps here: get children, make an iterator out of them. This simplifies things because there's no language means of creating iterators, and it's the printer object that knows how it will want its children iterated over. */ if (!itscm_is_iterator (children)) { ppscm_print_pp_type_error (_("result of pretty-printer \"children\" procedure is not" " a <gdb:iterator> object"), children); goto done; } iter = children; /* Use the prettyformat_arrays option if we are printing an array, and the pretty option otherwise. */ if (is_array) pretty = options->prettyformat_arrays; else { if (options->prettyformat == Val_prettyformat) pretty = 1; else pretty = options->prettyformat_structs; } done_flag = 0; for (i = 0; i < options->print_max; ++i) { int rc; SCM scm_name, v_scm; char *name; SCM item = itscm_safe_call_next_x (iter, gdbscm_memory_error_p); struct cleanup *inner_cleanup = make_cleanup (null_cleanup, NULL); if (gdbscm_is_exception (item)) { ppscm_print_exception_unless_memory_error (item, stream); break; } if (itscm_is_end_of_iteration (item)) { /* Set a flag so we can know whether we printed all the available elements. */ done_flag = 1; break; } if (! scm_is_pair (item)) { ppscm_print_pp_type_error (_("result of pretty-printer children iterator is not a pair" " or (end-of-iteration)"), item); continue; } scm_name = scm_car (item); v_scm = scm_cdr (item); if (!scm_is_string (scm_name)) { ppscm_print_pp_type_error (_("first element of pretty-printer children iterator is not" " a string"), item); continue; } name = gdbscm_scm_to_c_string (scm_name); make_cleanup (xfree, name); /* Print initial "{". For other elements, there are three cases: 1. Maps. Print a "," after each value element. 2. Arrays. Always print a ",". 3. Other. Always print a ",". */ if (i == 0) { if (printed_nothing) fputs_filtered ("{", stream); else fputs_filtered (" = {", stream); } else if (! is_map || i % 2 == 0) fputs_filtered (pretty ? "," : ", ", stream); /* In summary mode, we just want to print "= {...}" if there is a value. */ if (options->summary) { /* This increment tricks the post-loop logic to print what we want. */ ++i; /* Likewise. */ pretty = 0; break; } if (! is_map || i % 2 == 0) { if (pretty) { fputs_filtered ("\n", stream); print_spaces_filtered (2 + 2 * recurse, stream); } else wrap_here (n_spaces (2 + 2 *recurse)); } if (is_map && i % 2 == 0) fputs_filtered ("[", stream); else if (is_array) { /* We print the index, not whatever the child method returned as the name. */ if (options->print_array_indexes) fprintf_filtered (stream, "[%d] = ", i); } else if (! is_map) { fputs_filtered (name, stream); fputs_filtered (" = ", stream); } if (lsscm_is_lazy_string (v_scm)) { struct value_print_options local_opts = *options; local_opts.addressprint = 0; lsscm_val_print_lazy_string (v_scm, stream, &local_opts); } else if (scm_is_string (v_scm)) { char *output = gdbscm_scm_to_c_string (v_scm); fputs_filtered (output, stream); xfree (output); } else { SCM except_scm; struct value *value = vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE, v_scm, &except_scm, gdbarch, language); if (value == NULL) { ppscm_print_exception_unless_memory_error (except_scm, stream); break; } common_val_print (value, stream, recurse + 1, options, language); } if (is_map && i % 2 == 0) fputs_filtered ("] = ", stream); do_cleanups (inner_cleanup); } if (i) { if (!done_flag) { if (pretty) { fputs_filtered ("\n", stream); print_spaces_filtered (2 + 2 * recurse, stream); } fputs_filtered ("...", stream); } if (pretty) { fputs_filtered ("\n", stream); print_spaces_filtered (2 * recurse, stream); } fputs_filtered ("}", stream); } done: do_cleanups (cleanups); /* Play it safe, make sure ITER doesn't get GC'd. */ scm_remember_upto_here_1 (iter); }
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; }