1 /* General utility routines for GDB/Scheme code.
3 Copyright (C) 2014-2018 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. */
24 #include "guile-internal.h"
26 /* Define VARIABLES in the gdb module. */
29 gdbscm_define_variables (const scheme_variable *variables, int is_public)
31 const scheme_variable *sv;
33 for (sv = variables; sv->name != NULL; ++sv)
35 scm_c_define (sv->name, sv->value);
37 scm_c_export (sv->name, NULL);
41 /* Define FUNCTIONS in the gdb module. */
44 gdbscm_define_functions (const scheme_function *functions, int is_public)
46 const scheme_function *sf;
48 for (sf = functions; sf->name != NULL; ++sf)
50 SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional,
53 scm_set_procedure_property_x (proc, gdbscm_documentation_symbol,
54 gdbscm_scm_from_c_string (sf->doc_string));
56 scm_c_export (sf->name, NULL);
60 /* Define CONSTANTS in the gdb module. */
63 gdbscm_define_integer_constants (const scheme_integer_constant *constants,
66 const scheme_integer_constant *sc;
68 for (sc = constants; sc->name != NULL; ++sc)
70 scm_c_define (sc->name, scm_from_int (sc->value));
72 scm_c_export (sc->name, NULL);
76 /* scm_printf, alas it doesn't exist. */
79 gdbscm_printf (SCM port, const char *format, ...)
84 va_start (args, format);
85 string = xstrvprintf (format, args);
87 scm_puts (string, port);
91 /* Utility for calling from gdb to "display" an SCM object. */
94 gdbscm_debug_display (SCM obj)
96 SCM port = scm_current_output_port ();
98 scm_display (obj, port);
100 scm_force_output (port);
103 /* Utility for calling from gdb to "write" an SCM object. */
106 gdbscm_debug_write (SCM obj)
108 SCM port = scm_current_output_port ();
110 scm_write (obj, port);
112 scm_force_output (port);
115 /* Subroutine of gdbscm_parse_function_args to simplify it.
116 Return the number of keyword arguments. */
119 count_keywords (const SCM *keywords)
123 if (keywords == NULL)
125 for (i = 0; keywords[i] != SCM_BOOL_F; ++i)
131 /* Subroutine of gdbscm_parse_function_args to simplify it.
132 Validate an argument format string.
133 The result is a boolean indicating if "." was seen. */
136 validate_arg_format (const char *format)
139 int length = strlen (format);
140 int optional_position = -1;
141 int keyword_position = -1;
144 gdb_assert (length > 0);
146 for (p = format; *p != '\0'; ++p)
161 gdb_assert (keyword_position < 0);
162 gdb_assert (optional_position < 0);
163 optional_position = p - format;
166 gdb_assert (keyword_position < 0);
167 keyword_position = p - format;
170 gdb_assert (p[1] == '\0');
174 gdb_assert_not_reached ("invalid argument format character");
181 /* Our version of SCM_ASSERT_TYPE that calls gdbscm_make_type_error. */
182 #define CHECK_TYPE(ok, arg, position, func_name, expected_type) \
186 return gdbscm_make_type_error ((func_name), (position), (arg), \
191 /* Subroutine of gdbscm_parse_function_args to simplify it.
192 Check the type of ARG against FORMAT_CHAR and extract the value.
193 POSITION is the position of ARG in the argument list.
194 The result is #f upon success or a <gdb:exception> object. */
197 extract_arg (char format_char, SCM arg, void *argp,
198 const char *func_name, int position)
204 char **arg_ptr = (char **) argp;
206 CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position,
207 func_name, _("string"));
208 *arg_ptr = gdbscm_scm_to_c_string (arg).release ();
213 int *arg_ptr = (int *) argp;
215 /* While in Scheme, anything non-#f is "true", we're strict. */
216 CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name,
218 *arg_ptr = gdbscm_is_true (arg);
223 int *arg_ptr = (int *) argp;
225 CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX),
226 arg, position, func_name, _("int"));
227 *arg_ptr = scm_to_int (arg);
232 int *arg_ptr = (int *) argp;
234 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX),
235 arg, position, func_name, _("unsigned int"));
236 *arg_ptr = scm_to_uint (arg);
241 long *arg_ptr = (long *) argp;
243 CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX),
244 arg, position, func_name, _("long"));
245 *arg_ptr = scm_to_long (arg);
250 unsigned long *arg_ptr = (unsigned long *) argp;
252 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX),
253 arg, position, func_name, _("unsigned long"));
254 *arg_ptr = scm_to_ulong (arg);
259 LONGEST *arg_ptr = (LONGEST *) argp;
261 CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX),
262 arg, position, func_name, _("LONGEST"));
263 *arg_ptr = gdbscm_scm_to_longest (arg);
268 ULONGEST *arg_ptr = (ULONGEST *) argp;
270 CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX),
271 arg, position, func_name, _("ULONGEST"));
272 *arg_ptr = gdbscm_scm_to_ulongest (arg);
277 SCM *arg_ptr = (SCM *) argp;
283 gdb_assert_not_reached ("invalid argument format character");
291 /* Look up KEYWORD in KEYWORD_LIST.
292 The result is the index of the keyword in the list or -1 if not found. */
295 lookup_keyword (const SCM *keyword_list, SCM keyword)
299 while (keyword_list[i] != SCM_BOOL_F)
301 if (scm_is_eq (keyword_list[i], keyword))
309 /* Utility to parse required, optional, and keyword arguments to Scheme
310 functions. Modelled on PyArg_ParseTupleAndKeywords, but no attempt is made
311 at similarity or functionality.
312 There is no result, if there's an error a Scheme exception is thrown.
314 Guile provides scm_c_bind_keyword_arguments, and feel free to use it.
315 This is for times when we want a bit more parsing.
317 BEGINNING_ARG_POS is the position of the first argument passed to this
318 routine. It should be one of the SCM_ARGn values. It could be > SCM_ARG1
319 if the caller chooses not to parse one or more required arguments.
321 KEYWORDS may be NULL if there are no keywords.
324 s - string -> char *, malloc'd
325 t - boolean (gdb uses "t", for biT?) -> int
332 O - random scheme object
333 | - indicates the next set is for optional arguments
334 # - indicates the next set is for keyword arguments (must follow |)
335 . - indicates "rest" arguments are present, this character must appear last
337 FORMAT must match the definition from scm_c_{make,define}_gsubr.
338 Required and optional arguments appear in order in the format string.
339 Afterwards, keyword-based arguments are processed. There must be as many
340 remaining characters in the format string as their are keywords.
341 Except for "|#.", the number of characters in the format string must match
342 #required + #optional + #keywords.
344 The function is required to be defined in a compatible manner:
345 #required-args and #optional-arguments must match, and rest-arguments
346 must be specified if keyword args are desired, and/or regular "rest" args.
348 Example: For this function,
349 scm_c_define_gsubr ("execute", 2, 3, 1, foo);
350 the format string + keyword list could be any of:
351 1) "ss|ttt#tt", { "key1", "key2", NULL }
352 2) "ss|ttt.", { NULL }
353 3) "ss|ttt#t.", { "key1", NULL }
355 For required and optional args pass the SCM of the argument, and a
356 pointer to the value to hold the parsed result (type depends on format
357 char). After that pass the SCM containing the "rest" arguments followed
358 by pointers to values to hold parsed keyword arguments, and if specified
359 a pointer to hold the remaining contents of "rest".
361 For keyword arguments pass two pointers: the first is a pointer to an int
362 that will contain the position of the argument in the arg list, and the
363 second will contain result of processing the argument. The int pointed
364 to by the first value should be initialized to -1. It can then be used
365 to tell whether the keyword was present.
367 If both keyword and rest arguments are present, the caller must pass a
368 pointer to contain the new value of rest (after keyword args have been
371 There's currently no way, that I know of, to specify default values for
372 optional arguments in C-provided functions. At the moment they're a
373 work-in-progress. The caller should test SCM_UNBNDP for each optional
374 argument. Unbound optional arguments are ignored. */
377 gdbscm_parse_function_args (const char *func_name,
378 int beginning_arg_pos,
380 const char *format, ...)
384 int i, have_rest, num_keywords, position;
385 int have_optional = 0;
388 /* Keep track of malloc'd strings. We need to free them upon error. */
389 std::vector<char *> allocated_strings;
391 have_rest = validate_arg_format (format);
392 num_keywords = count_keywords (keywords);
394 va_start (args, format);
397 position = beginning_arg_pos;
399 /* Process required, optional arguments. */
401 while (*p && *p != '#' && *p != '.')
413 arg = va_arg (args, SCM);
414 if (!have_optional || !SCM_UNBNDP (arg))
416 arg_ptr = va_arg (args, void *);
417 status = extract_arg (*p, arg, arg_ptr, func_name, position);
418 if (!gdbscm_is_false (status))
421 allocated_strings.push_back (*(char **) arg_ptr);
427 /* Process keyword arguments. */
429 if (have_rest || num_keywords > 0)
430 rest = va_arg (args, SCM);
432 if (num_keywords > 0)
434 SCM *keyword_args = XALLOCAVEC (SCM, num_keywords);
435 int *keyword_positions = XALLOCAVEC (int, num_keywords);
437 gdb_assert (*p == '#');
440 for (i = 0; i < num_keywords; ++i)
442 keyword_args[i] = SCM_UNSPECIFIED;
443 keyword_positions[i] = -1;
446 while (scm_is_pair (rest)
447 && scm_is_keyword (scm_car (rest)))
449 SCM keyword = scm_car (rest);
451 i = lookup_keyword (keywords, keyword);
454 status = gdbscm_make_error (scm_arg_type_key, func_name,
455 _("Unrecognized keyword: ~a"),
456 scm_list_1 (keyword), keyword);
459 if (!scm_is_pair (scm_cdr (rest)))
461 status = gdbscm_make_error
462 (scm_arg_type_key, func_name,
463 _("Missing value for keyword argument"),
464 scm_list_1 (keyword), keyword);
467 keyword_args[i] = scm_cadr (rest);
468 keyword_positions[i] = position + 1;
469 rest = scm_cddr (rest);
473 for (i = 0; i < num_keywords; ++i)
475 int *arg_pos_ptr = va_arg (args, int *);
476 void *arg_ptr = va_arg (args, void *);
477 SCM arg = keyword_args[i];
479 if (! scm_is_eq (arg, SCM_UNSPECIFIED))
481 *arg_pos_ptr = keyword_positions[i];
482 status = extract_arg (p[i], arg, arg_ptr, func_name,
483 keyword_positions[i]);
484 if (!gdbscm_is_false (status))
487 allocated_strings.push_back (*(char **) arg_ptr);
492 /* Process "rest" arguments. */
496 if (num_keywords > 0)
498 SCM *rest_ptr = va_arg (args, SCM *);
505 if (! scm_is_null (rest))
507 status = gdbscm_make_error (scm_args_number_key, func_name,
508 _("Too many arguments"),
509 SCM_EOL, SCM_BOOL_F);
519 for (char *ptr : allocated_strings)
521 gdbscm_throw (status);
524 /* Return longest L as a scheme object. */
527 gdbscm_scm_from_longest (LONGEST l)
529 return scm_from_int64 (l);
532 /* Convert scheme object L to LONGEST.
533 It is an error to call this if L is not an integer in range of LONGEST.
534 (because the underlying Scheme function will thrown an exception,
535 which is not part of our contract with the caller). */
538 gdbscm_scm_to_longest (SCM l)
540 return scm_to_int64 (l);
543 /* Return unsigned longest L as a scheme object. */
546 gdbscm_scm_from_ulongest (ULONGEST l)
548 return scm_from_uint64 (l);
551 /* Convert scheme object U to ULONGEST.
552 It is an error to call this if U is not an integer in range of ULONGEST
553 (because the underlying Scheme function will thrown an exception,
554 which is not part of our contract with the caller). */
557 gdbscm_scm_to_ulongest (SCM u)
559 return scm_to_uint64 (u);
562 /* Same as scm_dynwind_free, but uses xfree. */
565 gdbscm_dynwind_xfree (void *ptr)
567 scm_dynwind_unwind_handler (xfree, ptr, SCM_F_WIND_EXPLICITLY);
570 /* Return non-zero if PROC is a procedure. */
573 gdbscm_is_procedure (SCM proc)
575 return gdbscm_is_true (scm_procedure_p (proc));
578 /* Same as xstrdup, but the string is allocated on the GC heap. */
581 gdbscm_gc_xstrdup (const char *str)
583 size_t len = strlen (str);
585 = (char *) scm_gc_malloc_pointerless (len + 1, "gdbscm_gc_xstrdup");
587 strcpy (result, str);
591 /* Return a duplicate of ARGV living on the GC heap. */
594 gdbscm_gc_dup_argv (char **argv)
600 for (len = 0, string_space = 0; argv[len] != NULL; ++len)
601 string_space += strlen (argv[len]) + 1;
603 /* Allocating "pointerless" works because the pointers are all
604 self-contained within the object. */
605 result = (char **) scm_gc_malloc_pointerless (((len + 1) * sizeof (char *))
607 "parameter enum list");
608 p = (char *) &result[len + 1];
610 for (i = 0; i < len; ++i)
618 return (const char * const *) result;
621 /* Return non-zero if the version of Guile being used it at least
622 MAJOR.MINOR.MICRO. */
625 gdbscm_guile_version_is_at_least (int major, int minor, int micro)
627 if (major > gdbscm_guile_major_version)
629 if (major < gdbscm_guile_major_version)
631 if (minor > gdbscm_guile_minor_version)
633 if (minor < gdbscm_guile_minor_version)
635 if (micro > gdbscm_guile_micro_version)