1 /* General utility routines for GDB/Scheme code.
3 Copyright (C) 2014-2015 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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
25 #include "guile-internal.h"
27 /* Define VARIABLES in the gdb module. */
30 gdbscm_define_variables (const scheme_variable *variables, int is_public)
32 const scheme_variable *sv;
34 for (sv = variables; sv->name != NULL; ++sv)
36 scm_c_define (sv->name, sv->value);
38 scm_c_export (sv->name, NULL);
42 /* Define FUNCTIONS in the gdb module. */
45 gdbscm_define_functions (const scheme_function *functions, int is_public)
47 const scheme_function *sf;
49 for (sf = functions; sf->name != NULL; ++sf)
51 SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional,
54 scm_set_procedure_property_x (proc, gdbscm_documentation_symbol,
55 gdbscm_scm_from_c_string (sf->doc_string));
57 scm_c_export (sf->name, NULL);
61 /* Define CONSTANTS in the gdb module. */
64 gdbscm_define_integer_constants (const scheme_integer_constant *constants,
67 const scheme_integer_constant *sc;
69 for (sc = constants; sc->name != NULL; ++sc)
71 scm_c_define (sc->name, scm_from_int (sc->value));
73 scm_c_export (sc->name, NULL);
77 /* scm_printf, alas it doesn't exist. */
80 gdbscm_printf (SCM port, const char *format, ...)
85 va_start (args, format);
86 string = xstrvprintf (format, args);
88 scm_puts (string, port);
92 /* Utility for calling from gdb to "display" an SCM object. */
95 gdbscm_debug_display (SCM obj)
97 SCM port = scm_current_output_port ();
99 scm_display (obj, port);
101 scm_force_output (port);
104 /* Utility for calling from gdb to "write" an SCM object. */
107 gdbscm_debug_write (SCM obj)
109 SCM port = scm_current_output_port ();
111 scm_write (obj, port);
113 scm_force_output (port);
116 /* Subroutine of gdbscm_parse_function_args to simplify it.
117 Return the number of keyword arguments. */
120 count_keywords (const SCM *keywords)
124 if (keywords == NULL)
126 for (i = 0; keywords[i] != SCM_BOOL_F; ++i)
132 /* Subroutine of gdbscm_parse_function_args to simplify it.
133 Validate an argument format string.
134 The result is a boolean indicating if "." was seen. */
137 validate_arg_format (const char *format)
140 int length = strlen (format);
141 int optional_position = -1;
142 int keyword_position = -1;
145 gdb_assert (length > 0);
147 for (p = format; *p != '\0'; ++p)
162 gdb_assert (keyword_position < 0);
163 gdb_assert (optional_position < 0);
164 optional_position = p - format;
167 gdb_assert (keyword_position < 0);
168 keyword_position = p - format;
171 gdb_assert (p[1] == '\0');
175 gdb_assert_not_reached ("invalid argument format character");
182 /* Our version of SCM_ASSERT_TYPE that calls gdbscm_make_type_error. */
183 #define CHECK_TYPE(ok, arg, position, func_name, expected_type) \
187 return gdbscm_make_type_error ((func_name), (position), (arg), \
192 /* Subroutine of gdbscm_parse_function_args to simplify it.
193 Check the type of ARG against FORMAT_CHAR and extract the value.
194 POSITION is the position of ARG in the argument list.
195 The result is #f upon success or a <gdb:exception> object. */
198 extract_arg (char format_char, SCM arg, void *argp,
199 const char *func_name, int position)
205 char **arg_ptr = argp;
207 CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position,
208 func_name, _("string"));
209 *arg_ptr = gdbscm_scm_to_c_string (arg);
216 /* While in Scheme, anything non-#f is "true", we're strict. */
217 CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name,
219 *arg_ptr = gdbscm_is_true (arg);
226 CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX),
227 arg, position, func_name, _("int"));
228 *arg_ptr = scm_to_int (arg);
235 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX),
236 arg, position, func_name, _("unsigned int"));
237 *arg_ptr = scm_to_uint (arg);
242 long *arg_ptr = argp;
244 CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX),
245 arg, position, func_name, _("long"));
246 *arg_ptr = scm_to_long (arg);
251 unsigned long *arg_ptr = argp;
253 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX),
254 arg, position, func_name, _("unsigned long"));
255 *arg_ptr = scm_to_ulong (arg);
260 LONGEST *arg_ptr = argp;
262 CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX),
263 arg, position, func_name, _("LONGEST"));
264 *arg_ptr = gdbscm_scm_to_longest (arg);
269 ULONGEST *arg_ptr = argp;
271 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX),
272 arg, position, func_name, _("ULONGEST"));
273 *arg_ptr = gdbscm_scm_to_ulongest (arg);
284 gdb_assert_not_reached ("invalid argument format character");
292 /* Look up KEYWORD in KEYWORD_LIST.
293 The result is the index of the keyword in the list or -1 if not found. */
296 lookup_keyword (const SCM *keyword_list, SCM keyword)
300 while (keyword_list[i] != SCM_BOOL_F)
302 if (scm_is_eq (keyword_list[i], keyword))
310 /* Utility to parse required, optional, and keyword arguments to Scheme
311 functions. Modelled on PyArg_ParseTupleAndKeywords, but no attempt is made
312 at similarity or functionality.
313 There is no result, if there's an error a Scheme exception is thrown.
315 Guile provides scm_c_bind_keyword_arguments, and feel free to use it.
316 This is for times when we want a bit more parsing.
318 BEGINNING_ARG_POS is the position of the first argument passed to this
319 routine. It should be one of the SCM_ARGn values. It could be > SCM_ARG1
320 if the caller chooses not to parse one or more required arguments.
322 KEYWORDS may be NULL if there are no keywords.
325 s - string -> char *, malloc'd
326 t - boolean (gdb uses "t", for biT?) -> int
333 O - random scheme object
334 | - indicates the next set is for optional arguments
335 # - indicates the next set is for keyword arguments (must follow |)
336 . - indicates "rest" arguments are present, this character must appear last
338 FORMAT must match the definition from scm_c_{make,define}_gsubr.
339 Required and optional arguments appear in order in the format string.
340 Afterwards, keyword-based arguments are processed. There must be as many
341 remaining characters in the format string as their are keywords.
342 Except for "|#.", the number of characters in the format string must match
343 #required + #optional + #keywords.
345 The function is required to be defined in a compatible manner:
346 #required-args and #optional-arguments must match, and rest-arguments
347 must be specified if keyword args are desired, and/or regular "rest" args.
349 Example: For this function,
350 scm_c_define_gsubr ("execute", 2, 3, 1, foo);
351 the format string + keyword list could be any of:
352 1) "ss|ttt#tt", { "key1", "key2", NULL }
353 2) "ss|ttt.", { NULL }
354 3) "ss|ttt#t.", { "key1", NULL }
356 For required and optional args pass the SCM of the argument, and a
357 pointer to the value to hold the parsed result (type depends on format
358 char). After that pass the SCM containing the "rest" arguments followed
359 by pointers to values to hold parsed keyword arguments, and if specified
360 a pointer to hold the remaining contents of "rest".
362 For keyword arguments pass two pointers: the first is a pointer to an int
363 that will contain the position of the argument in the arg list, and the
364 second will contain result of processing the argument. The int pointed
365 to by the first value should be initialized to -1. It can then be used
366 to tell whether the keyword was present.
368 If both keyword and rest arguments are present, the caller must pass a
369 pointer to contain the new value of rest (after keyword args have been
372 There's currently no way, that I know of, to specify default values for
373 optional arguments in C-provided functions. At the moment they're a
374 work-in-progress. The caller should test SCM_UNBNDP for each optional
375 argument. Unbound optional arguments are ignored. */
378 gdbscm_parse_function_args (const char *func_name,
379 int beginning_arg_pos,
381 const char *format, ...)
385 int i, have_rest, num_keywords, length, position;
386 int have_optional = 0;
389 /* Keep track of malloc'd strings. We need to free them upon error. */
390 VEC (char_ptr) *allocated_strings = NULL;
393 have_rest = validate_arg_format (format);
394 num_keywords = count_keywords (keywords);
396 va_start (args, format);
399 position = beginning_arg_pos;
401 /* Process required, optional arguments. */
403 while (*p && *p != '#' && *p != '.')
415 arg = va_arg (args, SCM);
416 if (!have_optional || !SCM_UNBNDP (arg))
418 arg_ptr = va_arg (args, void *);
419 status = extract_arg (*p, arg, arg_ptr, func_name, position);
420 if (!gdbscm_is_false (status))
423 VEC_safe_push (char_ptr, allocated_strings, *(char **) arg_ptr);
429 /* Process keyword arguments. */
431 if (have_rest || num_keywords > 0)
432 rest = va_arg (args, SCM);
434 if (num_keywords > 0)
436 SCM *keyword_args = (SCM *) alloca (num_keywords * sizeof (SCM));
437 int *keyword_positions = (int *) alloca (num_keywords * sizeof (int));
439 gdb_assert (*p == '#');
442 for (i = 0; i < num_keywords; ++i)
444 keyword_args[i] = SCM_UNSPECIFIED;
445 keyword_positions[i] = -1;
448 while (scm_is_pair (rest)
449 && scm_is_keyword (scm_car (rest)))
451 SCM keyword = scm_car (rest);
453 i = lookup_keyword (keywords, keyword);
456 status = gdbscm_make_error (scm_arg_type_key, func_name,
457 _("Unrecognized keyword: ~a"),
458 scm_list_1 (keyword), keyword);
461 if (!scm_is_pair (scm_cdr (rest)))
463 status = gdbscm_make_error
464 (scm_arg_type_key, func_name,
465 _("Missing value for keyword argument"),
466 scm_list_1 (keyword), keyword);
469 keyword_args[i] = scm_cadr (rest);
470 keyword_positions[i] = position + 1;
471 rest = scm_cddr (rest);
475 for (i = 0; i < num_keywords; ++i)
477 int *arg_pos_ptr = va_arg (args, int *);
478 void *arg_ptr = va_arg (args, void *);
479 SCM arg = keyword_args[i];
481 if (! scm_is_eq (arg, SCM_UNSPECIFIED))
483 *arg_pos_ptr = keyword_positions[i];
484 status = extract_arg (p[i], arg, arg_ptr, func_name,
485 keyword_positions[i]);
486 if (!gdbscm_is_false (status))
490 VEC_safe_push (char_ptr, allocated_strings,
497 /* Process "rest" arguments. */
501 if (num_keywords > 0)
503 SCM *rest_ptr = va_arg (args, SCM *);
510 if (! scm_is_null (rest))
512 status = gdbscm_make_error (scm_args_number_key, func_name,
513 _("Too many arguments"),
514 SCM_EOL, SCM_BOOL_F);
520 VEC_free (char_ptr, allocated_strings);
525 for (i = 0; VEC_iterate (char_ptr, allocated_strings, i, ptr); ++i)
527 VEC_free (char_ptr, allocated_strings);
528 gdbscm_throw (status);
531 /* Return longest L as a scheme object. */
534 gdbscm_scm_from_longest (LONGEST l)
536 return scm_from_int64 (l);
539 /* Convert scheme object L to LONGEST.
540 It is an error to call this if L is not an integer in range of LONGEST.
541 (because the underlying Scheme function will thrown an exception,
542 which is not part of our contract with the caller). */
545 gdbscm_scm_to_longest (SCM l)
547 return scm_to_int64 (l);
550 /* Return unsigned longest L as a scheme object. */
553 gdbscm_scm_from_ulongest (ULONGEST l)
555 return scm_from_uint64 (l);
558 /* Convert scheme object U to ULONGEST.
559 It is an error to call this if U is not an integer in range of ULONGEST
560 (because the underlying Scheme function will thrown an exception,
561 which is not part of our contract with the caller). */
564 gdbscm_scm_to_ulongest (SCM u)
566 return scm_to_uint64 (u);
569 /* Same as scm_dynwind_free, but uses xfree. */
572 gdbscm_dynwind_xfree (void *ptr)
574 scm_dynwind_unwind_handler (xfree, ptr, SCM_F_WIND_EXPLICITLY);
577 /* Return non-zero if PROC is a procedure. */
580 gdbscm_is_procedure (SCM proc)
582 return gdbscm_is_true (scm_procedure_p (proc));
585 /* Same as xstrdup, but the string is allocated on the GC heap. */
588 gdbscm_gc_xstrdup (const char *str)
590 size_t len = strlen (str);
591 char *result = scm_gc_malloc_pointerless (len + 1, "gdbscm_gc_xstrdup");
593 strcpy (result, str);
597 /* Return a duplicate of ARGV living on the GC heap. */
600 gdbscm_gc_dup_argv (char **argv)
606 for (len = 0, string_space = 0; argv[len] != NULL; ++len)
607 string_space += strlen (argv[len]) + 1;
609 /* Allocating "pointerless" works because the pointers are all
610 self-contained within the object. */
611 result = scm_gc_malloc_pointerless (((len + 1) * sizeof (char *))
612 + string_space, "parameter enum list");
613 p = (char *) &result[len + 1];
615 for (i = 0; i < len; ++i)
623 return (const char * const *) result;
626 /* Return non-zero if the version of Guile being used it at least
627 MAJOR.MINOR.MICRO. */
630 gdbscm_guile_version_is_at_least (int major, int minor, int micro)
632 if (major > gdbscm_guile_major_version)
634 if (major < gdbscm_guile_major_version)
636 if (minor > gdbscm_guile_minor_version)
638 if (minor < gdbscm_guile_minor_version)
640 if (micro > gdbscm_guile_micro_version)