1 /* GDB parameters implemented in Guile.
3 Copyright (C) 2008-2014 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 #include "exceptions.h"
25 #include "cli/cli-decode.h"
26 #include "completer.h"
28 #include "arch-utils.h"
29 #include "guile-internal.h"
31 /* A union that can hold anything described by enum var_types. */
35 /* Hold an integer value, for boolean and integer types. */
38 /* Hold an auto_boolean. */
39 enum auto_boolean autoboolval
;
41 /* Hold an unsigned integer value, for uinteger. */
44 /* Hold a string, for the various string types. */
47 /* Hold a string, for enums. */
48 const char *cstringval
;
53 Note: Parameters are added to gdb using a two step process:
54 1) Call make-parameter to create a <gdb:parameter> object.
55 2) Call register-parameter! to add the parameter to gdb.
56 It is done this way so that the constructor, make-parameter, doesn't have
57 any side-effects. This means that the smob needs to store everything
58 that was passed to make-parameter.
60 N.B. There is no free function for this smob.
61 All objects pointed to by this smob must live in GC space. */
63 typedef struct _param_smob
65 /* This always appears first. */
68 /* The parameter name. */
71 /* The last word of the command.
72 This is needed because add_cmd requires us to allocate space
76 /* One of the COMMAND_* constants. */
77 enum command_class cmd_class
;
79 /* The type of the parameter. */
82 /* The docs for the parameter. */
87 /* The corresponding gdb command objects.
88 These are NULL if the parameter has not been registered yet, or
89 is no longer registered. */
90 struct cmd_list_element
*set_command
;
91 struct cmd_list_element
*show_command
;
93 /* The value of the parameter. */
94 union pascm_variable value
;
96 /* For an enum parameter, the possible values. The vector lives in GC
97 space, it will be freed with the smob. */
98 const char * const *enumeration
;
100 /* The set_func funcion or #f if not specified.
101 This function is called *after* the parameter is set.
102 It returns a string that will be displayed to the user. */
105 /* The show_func function or #f if not specified.
106 This function returns the string that is printed. */
109 /* The <gdb:parameter> object we are contained in, needed to
110 protect/unprotect the object since a reference to it comes from
111 non-gc-managed space (the command context pointer). */
115 static const char param_smob_name
[] = "gdb:parameter";
117 /* The tag Guile knows the param smob by. */
118 static scm_t_bits parameter_smob_tag
;
120 /* Keywords used by make-parameter!. */
121 static SCM command_class_keyword
;
122 static SCM parameter_type_keyword
;
123 static SCM enum_list_keyword
;
124 static SCM set_func_keyword
;
125 static SCM show_func_keyword
;
126 static SCM doc_keyword
;
127 static SCM set_doc_keyword
;
128 static SCM show_doc_keyword
;
129 static SCM initial_value_keyword
;
130 static SCM auto_keyword
;
131 static SCM unlimited_keyword
;
133 static int pascm_is_valid (param_smob
*);
134 static const char *pascm_param_type_name (enum var_types type
);
135 static SCM
pascm_param_value (enum var_types type
, void *var
,
136 int arg_pos
, const char *func_name
);
138 /* Administrivia for parameter smobs. */
141 pascm_print_param_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
143 param_smob
*p_smob
= (param_smob
*) SCM_SMOB_DATA (self
);
146 gdbscm_printf (port
, "#<%s", param_smob_name
);
148 gdbscm_printf (port
, " %s", p_smob
->name
);
150 if (! pascm_is_valid (p_smob
))
151 scm_puts (" {invalid}", port
);
153 gdbscm_printf (port
, " %s", pascm_param_type_name (p_smob
->type
));
155 value
= pascm_param_value (p_smob
->type
, &p_smob
->value
,
156 GDBSCM_ARG_NONE
, NULL
);
157 scm_display (value
, port
);
159 scm_puts (">", port
);
161 scm_remember_upto_here_1 (self
);
163 /* Non-zero means success. */
167 /* Create an empty (uninitialized) parameter. */
170 pascm_make_param_smob (void)
172 param_smob
*p_smob
= (param_smob
*)
173 scm_gc_malloc (sizeof (param_smob
), param_smob_name
);
176 memset (p_smob
, 0, sizeof (*p_smob
));
177 p_smob
->cmd_class
= no_class
;
178 p_smob
->type
= var_boolean
;
179 p_smob
->set_func
= SCM_BOOL_F
;
180 p_smob
->show_func
= SCM_BOOL_F
;
181 p_scm
= scm_new_smob (parameter_smob_tag
, (scm_t_bits
) p_smob
);
182 p_smob
->containing_scm
= p_scm
;
183 gdbscm_init_gsmob (&p_smob
->base
);
188 /* Returns non-zero if SCM is a <gdb:parameter> object. */
191 pascm_is_parameter (SCM scm
)
193 return SCM_SMOB_PREDICATE (parameter_smob_tag
, scm
);
196 /* (gdb:parameter? scm) -> boolean */
199 gdbscm_parameter_p (SCM scm
)
201 return scm_from_bool (pascm_is_parameter (scm
));
204 /* Returns the <gdb:parameter> object in SELF.
205 Throws an exception if SELF is not a <gdb:parameter> object. */
208 pascm_get_param_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
210 SCM_ASSERT_TYPE (pascm_is_parameter (self
), self
, arg_pos
, func_name
,
216 /* Returns a pointer to the parameter smob of SELF.
217 Throws an exception if SELF is not a <gdb:parameter> object. */
220 pascm_get_param_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
222 SCM p_scm
= pascm_get_param_arg_unsafe (self
, arg_pos
, func_name
);
223 param_smob
*p_smob
= (param_smob
*) SCM_SMOB_DATA (p_scm
);
228 /* Return non-zero if parameter P_SMOB is valid. */
231 pascm_is_valid (param_smob
*p_smob
)
233 return p_smob
->set_command
!= NULL
;
236 /* A helper function which return the default documentation string for
237 a parameter (which is to say that it's undocumented). */
240 get_doc_string (void)
242 return xstrdup (_("This command is not documented."));
245 /* Subroutine of pascm_set_func, pascm_show_func to simplify them.
246 Signal the error returned from calling set_func/show_func. */
249 pascm_signal_setshow_error (SCM exception
, const char *msg
)
251 /* Don't print the stack if this was an error signalled by the command
253 if (gdbscm_user_error_p (gdbscm_exception_key (exception
)))
255 char *excp_text
= gdbscm_exception_message_to_string (exception
);
257 make_cleanup (xfree
, excp_text
);
258 error ("%s", excp_text
);
262 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
267 /* A callback function that is registered against the respective
268 add_setshow_* set_func prototype. This function will call
269 the Scheme function "set_func" which must exist.
270 Note: ARGS is always passed as NULL. */
273 pascm_set_func (char *args
, int from_tty
, struct cmd_list_element
*c
)
275 param_smob
*p_smob
= (param_smob
*) get_cmd_context (c
);
276 SCM self
, result
, exception
;
278 struct cleanup
*cleanups
;
280 gdb_assert (gdbscm_is_procedure (p_smob
->set_func
));
282 self
= p_smob
->containing_scm
;
284 result
= gdbscm_safe_call_1 (p_smob
->set_func
, self
, gdbscm_user_error_p
);
286 if (gdbscm_is_exception (result
))
288 pascm_signal_setshow_error (result
,
289 _("Error occurred setting parameter."));
292 if (!scm_is_string (result
))
293 error (_("Result of %s set-func is not a string."), p_smob
->name
);
295 msg
= gdbscm_scm_to_host_string (result
, NULL
, &exception
);
298 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
299 error (_("Error converting show text to host string."));
302 cleanups
= make_cleanup (xfree
, msg
);
303 /* GDB is usually silent when a parameter is set. */
305 fprintf_filtered (gdb_stdout
, "%s\n", msg
);
306 do_cleanups (cleanups
);
309 /* A callback function that is registered against the respective
310 add_setshow_* show_func prototype. This function will call
311 the Scheme function "show_func" which must exist and must return a
312 string that is then printed to FILE. */
315 pascm_show_func (struct ui_file
*file
, int from_tty
,
316 struct cmd_list_element
*c
, const char *value
)
318 param_smob
*p_smob
= (param_smob
*) get_cmd_context (c
);
319 SCM value_scm
, self
, result
, exception
;
321 struct cleanup
*cleanups
;
323 gdb_assert (gdbscm_is_procedure (p_smob
->show_func
));
325 value_scm
= gdbscm_scm_from_host_string (value
, strlen (value
));
326 if (gdbscm_is_exception (value_scm
))
328 error (_("Error converting parameter value \"%s\" to Scheme string."),
331 self
= p_smob
->containing_scm
;
333 result
= gdbscm_safe_call_2 (p_smob
->show_func
, self
, value_scm
,
334 gdbscm_user_error_p
);
336 if (gdbscm_is_exception (result
))
338 pascm_signal_setshow_error (result
,
339 _("Error occurred showing parameter."));
342 msg
= gdbscm_scm_to_host_string (result
, NULL
, &exception
);
345 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
346 error (_("Error converting show text to host string."));
349 cleanups
= make_cleanup (xfree
, msg
);
350 fprintf_filtered (file
, "%s\n", msg
);
351 do_cleanups (cleanups
);
354 /* A helper function that dispatches to the appropriate add_setshow
358 add_setshow_generic (enum var_types param_type
, enum command_class cmd_class
,
359 char *cmd_name
, param_smob
*self
,
360 char *set_doc
, char *show_doc
, char *help_doc
,
361 cmd_sfunc_ftype
*set_func
,
362 show_value_ftype
*show_func
,
363 struct cmd_list_element
**set_list
,
364 struct cmd_list_element
**show_list
,
365 struct cmd_list_element
**set_cmd
,
366 struct cmd_list_element
**show_cmd
)
368 struct cmd_list_element
*param
= NULL
;
369 const char *tmp_name
= NULL
;
374 add_setshow_boolean_cmd (cmd_name
, cmd_class
,
376 set_doc
, show_doc
, help_doc
,
378 set_list
, show_list
);
382 case var_auto_boolean
:
383 add_setshow_auto_boolean_cmd (cmd_name
, cmd_class
,
384 &self
->value
.autoboolval
,
385 set_doc
, show_doc
, help_doc
,
387 set_list
, show_list
);
391 add_setshow_uinteger_cmd (cmd_name
, cmd_class
,
392 &self
->value
.uintval
,
393 set_doc
, show_doc
, help_doc
,
395 set_list
, show_list
);
399 add_setshow_zinteger_cmd (cmd_name
, cmd_class
,
401 set_doc
, show_doc
, help_doc
,
403 set_list
, show_list
);
407 add_setshow_zuinteger_cmd (cmd_name
, cmd_class
,
408 &self
->value
.uintval
,
409 set_doc
, show_doc
, help_doc
,
411 set_list
, show_list
);
414 case var_zuinteger_unlimited
:
415 add_setshow_zuinteger_unlimited_cmd (cmd_name
, cmd_class
,
417 set_doc
, show_doc
, help_doc
,
419 set_list
, show_list
);
423 add_setshow_string_cmd (cmd_name
, cmd_class
,
424 &self
->value
.stringval
,
425 set_doc
, show_doc
, help_doc
,
427 set_list
, show_list
);
430 case var_string_noescape
:
431 add_setshow_string_noescape_cmd (cmd_name
, cmd_class
,
432 &self
->value
.stringval
,
433 set_doc
, show_doc
, help_doc
,
435 set_list
, show_list
);
439 case var_optional_filename
:
440 add_setshow_optional_filename_cmd (cmd_name
, cmd_class
,
441 &self
->value
.stringval
,
442 set_doc
, show_doc
, help_doc
,
444 set_list
, show_list
);
448 add_setshow_filename_cmd (cmd_name
, cmd_class
,
449 &self
->value
.stringval
,
450 set_doc
, show_doc
, help_doc
,
452 set_list
, show_list
);
456 add_setshow_enum_cmd (cmd_name
, cmd_class
,
458 &self
->value
.cstringval
,
459 set_doc
, show_doc
, help_doc
,
461 set_list
, show_list
);
462 /* Initialize the value, just in case. */
463 self
->value
.cstringval
= self
->enumeration
[0];
467 gdb_assert_not_reached ("bad param_type value");
470 /* Lookup created parameter, and register Scheme object against the
471 parameter context. Perform this task against both lists. */
473 param
= lookup_cmd (&tmp_name
, *show_list
, "", 0, 1);
474 gdb_assert (param
!= NULL
);
475 set_cmd_context (param
, self
);
479 param
= lookup_cmd (&tmp_name
, *set_list
, "", 0, 1);
480 gdb_assert (param
!= NULL
);
481 set_cmd_context (param
, self
);
485 /* Return an array of strings corresponding to the enum values for
487 Throws an exception if there's a problem with the values.
488 Space for the result is allocated from the GC heap. */
490 static const char * const *
491 compute_enum_list (SCM enum_values_scm
, int arg_pos
, const char *func_name
)
495 const char * const *result
;
497 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (enum_values_scm
)),
498 enum_values_scm
, arg_pos
, func_name
, _("list"));
500 size
= scm_ilength (enum_values_scm
);
503 gdbscm_out_of_range_error (FUNC_NAME
, arg_pos
, enum_values_scm
,
504 _("enumeration list is empty"));
507 enum_values
= xmalloc ((size
+ 1) * sizeof (char *));
508 memset (enum_values
, 0, (size
+ 1) * sizeof (char *));
511 while (!scm_is_eq (enum_values_scm
, SCM_EOL
))
513 SCM value
= scm_car (enum_values_scm
);
516 if (!scm_is_string (value
))
518 freeargv (enum_values
);
519 SCM_ASSERT_TYPE (0, value
, arg_pos
, func_name
, _("string"));
521 enum_values
[i
] = gdbscm_scm_to_host_string (value
, NULL
, &exception
);
522 if (enum_values
[i
] == NULL
)
524 freeargv (enum_values
);
525 gdbscm_throw (exception
);
528 enum_values_scm
= scm_cdr (enum_values_scm
);
530 gdb_assert (i
== size
);
532 result
= gdbscm_gc_dup_argv (enum_values
);
533 freeargv (enum_values
);
537 static const scheme_integer_constant parameter_types
[] =
539 /* Note: var_integer is deprecated, and intentionally does not
541 { "PARAM_BOOLEAN", var_boolean
}, /* ARI: var_boolean */
542 { "PARAM_AUTO_BOOLEAN", var_auto_boolean
},
543 { "PARAM_ZINTEGER", var_zinteger
},
544 { "PARAM_UINTEGER", var_uinteger
},
545 { "PARAM_ZUINTEGER", var_zuinteger
},
546 { "PARAM_ZUINTEGER_UNLIMITED", var_zuinteger_unlimited
},
547 { "PARAM_STRING", var_string
},
548 { "PARAM_STRING_NOESCAPE", var_string_noescape
},
549 { "PARAM_OPTIONAL_FILENAME", var_optional_filename
},
550 { "PARAM_FILENAME", var_filename
},
551 { "PARAM_ENUM", var_enum
},
553 END_INTEGER_CONSTANTS
556 /* Return non-zero if PARAM_TYPE is a valid parameter type. */
559 pascm_valid_parameter_type_p (int param_type
)
563 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
565 if (parameter_types
[i
].value
== param_type
)
572 /* Return PARAM_TYPE as a string. */
575 pascm_param_type_name (enum var_types param_type
)
579 for (i
= 0; parameter_types
[i
].name
!= NULL
; ++i
)
581 if (parameter_types
[i
].value
== param_type
)
582 return parameter_types
[i
].name
;
585 gdb_assert_not_reached ("bad parameter type");
588 /* Return the value of a gdb parameter as a Scheme value.
589 If TYPE is not supported, then a <gdb:exception> object is returned. */
592 pascm_param_value (enum var_types type
, void *var
,
593 int arg_pos
, const char *func_name
)
595 /* Note: We *could* support var_integer here in case someone is trying to get
596 the value of a Python-created parameter (which is the only place that
597 still supports var_integer). To further discourage its use we do not. */
602 case var_string_noescape
:
603 case var_optional_filename
:
607 char *str
= * (char **) var
;
611 return gdbscm_scm_from_host_string (str
, strlen (str
));
622 case var_auto_boolean
:
624 enum auto_boolean ab
= * (enum auto_boolean
*) var
;
626 if (ab
== AUTO_BOOLEAN_TRUE
)
628 else if (ab
== AUTO_BOOLEAN_FALSE
)
634 case var_zuinteger_unlimited
:
635 if (* (int *) var
== -1)
636 return unlimited_keyword
;
637 gdb_assert (* (int *) var
>= 0);
640 return scm_from_int (* (int *) var
);
643 if (* (unsigned int *) var
== UINT_MAX
)
644 return unlimited_keyword
;
647 return scm_from_uint (* (unsigned int *) var
);
653 return gdbscm_make_out_of_range_error (func_name
, arg_pos
,
655 _("program error: unhandled type"));
658 /* Set the value of a parameter of type TYPE in VAR from VALUE.
659 ENUMERATION is the list of enum values for enum parameters, otherwise NULL.
660 Throws a Scheme exception if VALUE_SCM is invalid for TYPE. */
663 pascm_set_param_value_x (enum var_types type
, union pascm_variable
*var
,
664 const char * const *enumeration
,
665 SCM value
, int arg_pos
, const char *func_name
)
670 case var_string_noescape
:
671 case var_optional_filename
:
673 SCM_ASSERT_TYPE (scm_is_string (value
)
674 || (type
!= var_filename
675 && gdbscm_is_false (value
)),
676 value
, arg_pos
, func_name
,
677 _("string or #f for non-PARAM_FILENAME parameters"));
678 if (gdbscm_is_false (value
))
680 xfree (var
->stringval
);
681 if (type
== var_optional_filename
)
682 var
->stringval
= xstrdup ("");
684 var
->stringval
= NULL
;
691 string
= gdbscm_scm_to_host_string (value
, NULL
, &exception
);
693 gdbscm_throw (exception
);
694 xfree (var
->stringval
);
695 var
->stringval
= string
;
705 SCM_ASSERT_TYPE (scm_is_string (value
), value
, arg_pos
, func_name
,
707 str
= gdbscm_scm_to_host_string (value
, NULL
, &exception
);
709 gdbscm_throw (exception
);
710 for (i
= 0; enumeration
[i
]; ++i
)
712 if (strcmp (enumeration
[i
], str
) == 0)
716 if (enumeration
[i
] == NULL
)
718 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
719 _("not member of enumeration"));
721 var
->cstringval
= enumeration
[i
];
726 SCM_ASSERT_TYPE (gdbscm_is_bool (value
), value
, arg_pos
, func_name
,
728 var
->intval
= gdbscm_is_true (value
);
731 case var_auto_boolean
:
732 SCM_ASSERT_TYPE (gdbscm_is_bool (value
)
733 || scm_is_eq (value
, auto_keyword
),
734 value
, arg_pos
, func_name
,
735 _("boolean or #:auto"));
736 if (scm_is_eq (value
, auto_keyword
))
737 var
->autoboolval
= AUTO_BOOLEAN_AUTO
;
738 else if (gdbscm_is_true (value
))
739 var
->autoboolval
= AUTO_BOOLEAN_TRUE
;
741 var
->autoboolval
= AUTO_BOOLEAN_FALSE
;
747 case var_zuinteger_unlimited
:
748 if (type
== var_uinteger
749 || type
== var_zuinteger_unlimited
)
751 SCM_ASSERT_TYPE (gdbscm_is_bool (value
)
752 || scm_is_eq (value
, unlimited_keyword
),
753 value
, arg_pos
, func_name
,
754 _("integer or #:unlimited"));
755 if (scm_is_eq (value
, unlimited_keyword
))
757 if (type
== var_uinteger
)
758 var
->intval
= UINT_MAX
;
766 SCM_ASSERT_TYPE (scm_is_integer (value
), value
, arg_pos
, func_name
,
770 if (type
== var_uinteger
771 || type
== var_zuinteger
)
773 unsigned int u
= scm_to_uint (value
);
775 if (type
== var_uinteger
&& u
== 0)
781 int i
= scm_to_int (value
);
783 if (type
== var_zuinteger_unlimited
&& i
< -1)
785 gdbscm_out_of_range_error (func_name
, arg_pos
, value
,
793 gdb_assert_not_reached ("bad parameter type");
797 /* Parameter Scheme functions. */
799 /* (make-parameter name
800 [#:command-class cmd-class] [#:parameter-type param-type]
801 [#:enum-list enum-list] [#:set-func function] [#:show-func function]
802 [#:doc <string>] [#:set-doc <string>] [#:show-doc <string>]
803 [#:initial-value initial-value]) -> <gdb:parameter>
805 NAME is the name of the parameter. It may consist of multiple
806 words, in which case the final word is the name of the new parameter,
807 and earlier words must be prefix commands.
809 CMD-CLASS is the kind of command. It should be one of the COMMAND_*
810 constants defined in the gdb module.
812 PARAM_TYPE is the type of the parameter. It should be one of the
813 PARAM_* constants defined in the gdb module.
815 If PARAM-TYPE is PARAM_ENUM, then ENUM-LIST is a list of strings that
816 are the valid values for this parameter. The first value is the default.
818 SET-FUNC, if provided, is called after the parameter is set.
819 It is a function of one parameter: the <gdb:parameter> object.
820 It must return a string to be displayed to the user.
821 Setting a parameter is typically a silent operation, so typically ""
824 SHOW-FUNC, if provided, returns the string that is printed.
825 It is a function of two parameters: the <gdb:parameter> object
826 and the current value of the parameter as a string.
828 DOC, SET-DOC, SHOW-DOC are the doc strings for the parameter.
830 INITIAL-VALUE is the initial value of the parameter.
832 The result is the <gdb:parameter> Scheme object.
833 The parameter is not available to be used yet, however.
834 It must still be added to gdb with register-parameter!. */
837 gdbscm_make_parameter (SCM name_scm
, SCM rest
)
839 const SCM keywords
[] = {
840 command_class_keyword
, parameter_type_keyword
, enum_list_keyword
,
841 set_func_keyword
, show_func_keyword
,
842 doc_keyword
, set_doc_keyword
, show_doc_keyword
,
843 initial_value_keyword
, SCM_BOOL_F
845 int cmd_class_arg_pos
= -1, param_type_arg_pos
= -1;
846 int enum_list_arg_pos
= -1, set_func_arg_pos
= -1, show_func_arg_pos
= -1;
847 int doc_arg_pos
= -1, set_doc_arg_pos
= -1, show_doc_arg_pos
= -1;
848 int initial_value_arg_pos
= -1;
851 int cmd_class
= no_class
;
852 int param_type
= var_boolean
;
853 SCM enum_list_scm
= SCM_BOOL_F
;
854 SCM set_func
= SCM_BOOL_F
, show_func
= SCM_BOOL_F
;
855 char *doc
= NULL
, *set_doc
= NULL
, *show_doc
= NULL
;
856 SCM initial_value_scm
= SCM_BOOL_F
;
857 const char * const *enum_list
= NULL
;
861 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#iiOOOsssO",
862 name_scm
, &name
, rest
,
863 &cmd_class_arg_pos
, &cmd_class
,
864 ¶m_type_arg_pos
, ¶m_type
,
865 &enum_list_arg_pos
, &enum_list_scm
,
866 &set_func_arg_pos
, &set_func
,
867 &show_func_arg_pos
, &show_func
,
869 &set_doc_arg_pos
, &set_doc
,
870 &show_doc_arg_pos
, &show_doc
,
871 &initial_value_arg_pos
, &initial_value_scm
);
873 /* If doc is NULL, leave it NULL. See add_setshow_cmd_full. */
875 set_doc
= get_doc_string ();
876 if (show_doc
== NULL
)
877 show_doc
= get_doc_string ();
880 name
= gdbscm_canonicalize_command_name (s
, 0);
885 doc
= gdbscm_gc_xstrdup (s
);
889 set_doc
= gdbscm_gc_xstrdup (s
);
892 show_doc
= gdbscm_gc_xstrdup (s
);
895 if (!gdbscm_valid_command_class_p (cmd_class
))
897 gdbscm_out_of_range_error (FUNC_NAME
, cmd_class_arg_pos
,
898 scm_from_int (cmd_class
),
899 _("invalid command class argument"));
901 if (!pascm_valid_parameter_type_p (param_type
))
903 gdbscm_out_of_range_error (FUNC_NAME
, param_type_arg_pos
,
904 scm_from_int (param_type
),
905 _("invalid parameter type argument"));
907 if (enum_list_arg_pos
> 0 && param_type
!= var_enum
)
909 gdbscm_misc_error (FUNC_NAME
, enum_list_arg_pos
, enum_list_scm
,
910 _("#:enum-values can only be provided with PARAM_ENUM"));
912 if (enum_list_arg_pos
< 0 && param_type
== var_enum
)
914 gdbscm_misc_error (FUNC_NAME
, GDBSCM_ARG_NONE
, SCM_BOOL_F
,
915 _("PARAM_ENUM requires an enum-values argument"));
917 if (set_func_arg_pos
> 0)
919 SCM_ASSERT_TYPE (gdbscm_is_procedure (set_func
), set_func
,
920 set_func_arg_pos
, FUNC_NAME
, _("procedure"));
922 if (show_func_arg_pos
> 0)
924 SCM_ASSERT_TYPE (gdbscm_is_procedure (show_func
), show_func
,
925 show_func_arg_pos
, FUNC_NAME
, _("procedure"));
927 if (param_type
== var_enum
)
929 /* Note: enum_list lives in GC space, so we don't have to worry about
930 freeing it if we later throw an exception. */
931 enum_list
= compute_enum_list (enum_list_scm
, enum_list_arg_pos
,
935 /* If initial-value is a function, we need the parameter object constructed
936 to pass it to the function. A typical thing the function may want to do
937 is add an object-property to it to record the last known good value. */
938 p_scm
= pascm_make_param_smob ();
939 p_smob
= (param_smob
*) SCM_SMOB_DATA (p_scm
);
940 /* These are all stored in GC space so that we don't have to worry about
941 freeing them if we throw an exception. */
943 p_smob
->cmd_class
= cmd_class
;
944 p_smob
->type
= (enum var_types
) param_type
;
946 p_smob
->set_doc
= set_doc
;
947 p_smob
->show_doc
= show_doc
;
948 p_smob
->enumeration
= enum_list
;
949 p_smob
->set_func
= set_func
;
950 p_smob
->show_func
= show_func
;
952 if (initial_value_arg_pos
> 0)
954 if (gdbscm_is_procedure (initial_value_scm
))
956 initial_value_scm
= gdbscm_safe_call_1 (initial_value_scm
,
957 p_smob
->containing_scm
, NULL
);
958 if (gdbscm_is_exception (initial_value_scm
))
959 gdbscm_throw (initial_value_scm
);
961 pascm_set_param_value_x (param_type
, &p_smob
->value
, enum_list
,
963 initial_value_arg_pos
, FUNC_NAME
);
969 /* (register-parameter! <gdb:parameter>) -> unspecified
971 It is an error to register a parameter more than once. */
974 gdbscm_register_parameter_x (SCM self
)
977 = pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
979 struct cmd_list_element
**set_list
, **show_list
;
980 volatile struct gdb_exception except
;
982 if (pascm_is_valid (p_smob
))
983 scm_misc_error (FUNC_NAME
, _("parameter is already registered"), SCM_EOL
);
985 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
986 &set_list
, &setlist
);
988 cmd_name
= gdbscm_parse_command_name (p_smob
->name
, FUNC_NAME
, SCM_ARG1
,
989 &show_list
, &showlist
);
990 p_smob
->cmd_name
= gdbscm_gc_xstrdup (cmd_name
);
993 TRY_CATCH (except
, RETURN_MASK_ALL
)
995 add_setshow_generic (p_smob
->type
, p_smob
->cmd_class
,
996 p_smob
->cmd_name
, p_smob
,
997 p_smob
->set_doc
, p_smob
->show_doc
, p_smob
->doc
,
998 (gdbscm_is_procedure (p_smob
->set_func
)
999 ? pascm_set_func
: NULL
),
1000 (gdbscm_is_procedure (p_smob
->show_func
)
1001 ? pascm_show_func
: NULL
),
1002 set_list
, show_list
,
1003 &p_smob
->set_command
, &p_smob
->show_command
);
1005 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1007 /* Note: At this point the parameter exists in gdb.
1008 So no more errors after this point. */
1010 /* The owner of this parameter is not in GC-controlled memory, so we need
1011 to protect it from GC until the parameter is deleted. */
1012 scm_gc_protect_object (p_smob
->containing_scm
);
1014 return SCM_UNSPECIFIED
;
1017 /* (parameter-value <gdb:parameter>) -> value
1018 (parameter-value <string>) -> value */
1021 gdbscm_parameter_value (SCM self
)
1023 SCM_ASSERT_TYPE (pascm_is_parameter (self
) || scm_is_string (self
),
1024 self
, SCM_ARG1
, FUNC_NAME
, _("<gdb:parameter> or string"));
1026 if (pascm_is_parameter (self
))
1028 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1031 return pascm_param_value (p_smob
->type
, &p_smob
->value
,
1032 SCM_ARG1
, FUNC_NAME
);
1038 struct cmd_list_element
*alias
, *prefix
, *cmd
;
1042 volatile struct gdb_exception except
;
1044 name
= gdbscm_scm_to_host_string (self
, NULL
, &except_scm
);
1046 gdbscm_throw (except_scm
);
1047 newarg
= concat ("show ", name
, (char *) NULL
);
1048 TRY_CATCH (except
, RETURN_MASK_ALL
)
1050 found
= lookup_cmd_composition (newarg
, &alias
, &prefix
, &cmd
);
1054 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1057 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1058 _("parameter not found"));
1060 if (cmd
->var
== NULL
)
1062 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1063 _("not a parameter"));
1066 return pascm_param_value (cmd
->var_type
, cmd
->var
, SCM_ARG1
, FUNC_NAME
);
1070 /* (set-parameter-value! <gdb:parameter> value) -> unspecified */
1073 gdbscm_set_parameter_value_x (SCM self
, SCM value
)
1075 param_smob
*p_smob
= pascm_get_param_smob_arg_unsafe (self
, SCM_ARG1
,
1078 pascm_set_param_value_x (p_smob
->type
, &p_smob
->value
, p_smob
->enumeration
,
1079 value
, SCM_ARG2
, FUNC_NAME
);
1081 return SCM_UNSPECIFIED
;
1084 /* Initialize the Scheme parameter support. */
1086 static const scheme_function parameter_functions
[] =
1088 { "make-parameter", 1, 0, 1, gdbscm_make_parameter
,
1090 Make a GDB parameter object.\n\
1093 [#:command-class <cmd-class>] [#:parameter-type <parameter-type>]\n\
1094 [#:enum-list <enum-list>]\n\
1095 [#:set-func function] [#:show-func function]\n\
1096 [#:doc string] [#:set-doc string] [#:show-doc string]\n\
1097 [#:initial-value initial-value]\n\
1098 name: The name of the command. It may consist of multiple words,\n\
1099 in which case the final word is the name of the new parameter, and\n\
1100 earlier words must be prefix commands.\n\
1101 cmd-class: The class of the command, one of COMMAND_*.\n\
1102 The default is COMMAND_NONE.\n\
1103 parameter-type: The kind of parameter, one of PARAM_*\n\
1104 The default is PARAM_BOOLEAN.\n\
1105 enum-list: If parameter-type is PARAM_ENUM, then this specifies the set\n\
1106 of values of the enum.\n\
1107 set-func: A function of one parameter: the <gdb:parameter> object.\n\
1108 Called *after* the parameter has been set. Returns either \"\" or a\n\
1109 non-empty string to be displayed to the user.\n\
1110 If non-empty, GDB will add a trailing newline.\n\
1111 show-func: A function of two parameters: the <gdb:parameter> object\n\
1112 and the string representation of the current value.\n\
1113 The result is a string to be displayed to the user.\n\
1114 GDB will add a trailing newline.\n\
1115 doc: The \"doc string\" of the parameter.\n\
1116 set-doc: The \"doc string\" when setting the parameter.\n\
1117 show-doc: The \"doc string\" when showing the parameter.\n\
1118 initial-value: The initial value of the parameter." },
1120 { "register-parameter!", 1, 0, 0, gdbscm_register_parameter_x
,
1122 Register a <gdb:parameter> object with GDB." },
1124 { "parameter?", 1, 0, 0, gdbscm_parameter_p
,
1126 Return #t if the object is a <gdb:parameter> object." },
1128 { "parameter-value", 1, 0, 0, gdbscm_parameter_value
,
1130 Return the value of a <gdb:parameter> object\n\
1131 or any gdb parameter if param is a string naming the parameter." },
1133 { "set-parameter-value!", 2, 0, 0, gdbscm_set_parameter_value_x
,
1135 Set the value of a <gdb:parameter> object.\n\
1137 Arguments: <gdb:parameter> value" },
1143 gdbscm_initialize_parameters (void)
1146 = gdbscm_make_smob_type (param_smob_name
, sizeof (param_smob
));
1147 scm_set_smob_print (parameter_smob_tag
, pascm_print_param_smob
);
1149 gdbscm_define_integer_constants (parameter_types
, 1);
1150 gdbscm_define_functions (parameter_functions
, 1);
1152 command_class_keyword
= scm_from_latin1_keyword ("command-class");
1153 parameter_type_keyword
= scm_from_latin1_keyword ("parameter-type");
1154 enum_list_keyword
= scm_from_latin1_keyword ("enum-list");
1155 set_func_keyword
= scm_from_latin1_keyword ("set-func");
1156 show_func_keyword
= scm_from_latin1_keyword ("show-func");
1157 doc_keyword
= scm_from_latin1_keyword ("doc");
1158 set_doc_keyword
= scm_from_latin1_keyword ("set-doc");
1159 show_doc_keyword
= scm_from_latin1_keyword ("show-doc");
1160 initial_value_keyword
= scm_from_latin1_keyword ("initial-value");
1161 auto_keyword
= scm_from_latin1_keyword ("auto");
1162 unlimited_keyword
= scm_from_latin1_keyword ("unlimited");