Add Guile as an extension language.
* NEWS: Mention Guile scripting.
* Makefile.in (SUBDIR_GUILE_OBS): New variable.
(SUBDIR_GUILE_SRCS, SUBDIR_GUILE_DEPS): New variables
(SUBDIR_GUILE_LDFLAGS, SUBDIR_GUILE_CFLAGS): New variables.
(INTERNAL_CPPFLAGS): Add GUILE_CPPFLAGS.
(CLIBS): Add GUILE_LIBS.
(install-guile): New rule.
(guile.o): New rule.
(scm-arch.o, scm-auto-load.o, scm-block.o): New rules.
(scm-breakpoint.o, scm-disasm.o, scm-exception.o): New rules.
(scm-frame.o, scm-iterator.o, scm-lazy-string.o): New rules.
(scm-math.o, scm-objfile.o, scm-ports.o): New rules.
(scm-pretty-print.o, scm-safe-call.o, scm-gsmob.o): New rules.
(scm-string.o, scm-symbol.o, scm-symtab.o): New rules.
(scm-type.o, scm-utils.o, scm-value.o): New rules.
* configure.ac: New option --with-guile.
* configure: Regenerate.
* config.in: Regenerate.
* auto-load.c: Remove #include "python/python.h". Add #include
"gdb/section-scripts.h".
(source_section_scripts): Handle Guile scripts.
(_initialize_auto_load): Add name of Guile objfile script to
scripts-directory help text.
* breakpoint.c (condition_command): Tweak comment to include Scheme.
* breakpoint.h (gdbscm_breakpoint_object): Add forward decl.
(struct breakpoint): New member scm_bp_object.
* defs.h (enum command_control_type): New value guile_control.
* cli/cli-cmds.c: Remove #include "python/python.h". Add #include
"extension.h".
(show_user): Update comment.
(_initialize_cli_cmds): Update help text for "show user". Update help
text for max-user-call-depth.
* cli/cli-script.c: Remove #include "python/python.h". Add #include
"extension.h".
(multi_line_command_p): Add guile_control.
(print_command_lines): Handle guile_control.
(execute_control_command, recurse_read_control_structure): Ditto.
(process_next_line): Recognize "guile" commands.
* disasm.c (gdb_disassemble_info): Make non-static.
* disasm.h: #include "dis-asm.h".
(struct gdbarch): Add forward decl.
(gdb_disassemble_info): Declare.
* extension.c: #include "guile/guile.h".
(extension_languages): Add guile.
(get_ext_lang_defn): Handle EXT_LANG_GDB.
* extension.h (enum extension_language): New value EXT_LANG_GUILE.
* gdbtypes.c (get_unsigned_type_max): New function.
(get_signed_type_minmax): New function.
* gdbtypes.h (get_unsigned_type_max): Declare.
(get_signed_type_minmax): Declare.
* guile/README: New file.
* guile/guile-internal.h: New file.
* guile/guile.c: New file.
* guile/guile.h: New file.
* guile/scm-arch.c: New file.
* guile/scm-auto-load.c: New file.
* guile/scm-block.c: New file.
* guile/scm-breakpoint.c: New file.
* guile/scm-disasm.c: New file.
* guile/scm-exception.c: New file.
* guile/scm-frame.c: New file.
* guile/scm-gsmob.c: New file.
* guile/scm-iterator.c: New file.
* guile/scm-lazy-string.c: New file.
* guile/scm-math.c: New file.
* guile/scm-objfile.c: New file.
* guile/scm-ports.c: New file.
* guile/scm-pretty-print.c: New file.
* guile/scm-safe-call.c: New file.
* guile/scm-string.c: New file.
* guile/scm-symbol.c: New file.
* guile/scm-symtab.c: New file.
* guile/scm-type.c: New file.
* guile/scm-utils.c: New file.
* guile/scm-value.c: New file.
* guile/lib/gdb.scm: New file.
* guile/lib/gdb/boot.scm: New file.
* guile/lib/gdb/experimental.scm: New file.
* guile/lib/gdb/init.scm: New file.
* guile/lib/gdb/iterator.scm: New file.
* guile/lib/gdb/printing.scm: New file.
* guile/lib/gdb/types.scm: New file.
* data-directory/Makefile.in (GUILE_SRCDIR): New variable.
(VPATH): Add $(GUILE_SRCDIR).
(GUILE_DIR): New variable.
(GUILE_INSTALL_DIR, GUILE_FILES): New variables.
(all): Add stamp-guile dependency.
(stamp-guile): New rule.
(clean-guile, install-guile, uninstall-guile): New rules.
(install-only): Add install-guile dependency.
(uninstall): Add uninstall-guile dependency.
(clean): Add clean-guile dependency.
doc/
* Makefile.in (GDB_DOC_FILES): Add guile.texi.
* gdb.texinfo (Auto-loading): Add set/show auto-load guile-scripts.
(Extending GDB): New menu entries Guile, Multiple Extension Languages.
(Guile docs): Include guile.texi.
(objfile-gdbdotext file): Add objfile-gdb.scm.
(dotdebug_gdb_scripts section): Mention Guile scripts.
(Multiple Extension Languages): New node.
* guile.texi: New file.
testsuite/
* configure.ac (AC_OUTPUT): Add gdb.guile.
* configure: Regenerate.
* lib/gdb-guile.exp: New file.
* lib/gdb.exp (get_target_charset): New function.
* gdb.base/help.exp: Update expected output from "apropos apropos".
* gdb.guile/Makefile.in: New file.
* gdb.guile/guile.exp: New file.
* gdb.guile/scm-arch.c: New file.
* gdb.guile/scm-arch.exp: New file.
* gdb.guile/scm-block.c: New file.
* gdb.guile/scm-block.exp: New file.
* gdb.guile/scm-breakpoint.c: New file.
* gdb.guile/scm-breakpoint.exp: New file.
* gdb.guile/scm-disasm.c: New file.
* gdb.guile/scm-disasm.exp: New file.
* gdb.guile/scm-equal.c: New file.
* gdb.guile/scm-equal.exp: New file.
* gdb.guile/scm-error.exp: New file.
* gdb.guile/scm-error.scm: New file.
* gdb.guile/scm-frame-args.c: New file.
* gdb.guile/scm-frame-args.exp: New file.
* gdb.guile/scm-frame-args.scm: New file.
* gdb.guile/scm-frame-inline.c: New file.
* gdb.guile/scm-frame-inline.exp: New file.
* gdb.guile/scm-frame.c: New file.
* gdb.guile/scm-frame.exp: New file.
* gdb.guile/scm-generics.exp: New file.
* gdb.guile/scm-gsmob.exp: New file.
* gdb.guile/scm-iterator.c: New file.
* gdb.guile/scm-iterator.exp: New file.
* gdb.guile/scm-math.c: New file.
* gdb.guile/scm-math.exp: New file.
* gdb.guile/scm-objfile-script-gdb.in: New file.
* gdb.guile/scm-objfile-script.c: New file.
* gdb.guile/scm-objfile-script.exp: New file.
* gdb.guile/scm-objfile.c: New file.
* gdb.guile/scm-objfile.exp: New file.
* gdb.guile/scm-ports.exp: New file.
* gdb.guile/scm-pretty-print.c: New file.
* gdb.guile/scm-pretty-print.exp: New file.
* gdb.guile/scm-pretty-print.scm: New file.
* gdb.guile/scm-section-script.c: New file.
* gdb.guile/scm-section-script.exp: New file.
* gdb.guile/scm-section-script.scm: New file.
* gdb.guile/scm-symbol.c: New file.
* gdb.guile/scm-symbol.exp: New file.
* gdb.guile/scm-symtab-2.c: New file.
* gdb.guile/scm-symtab.c: New file.
* gdb.guile/scm-symtab.exp: New file.
* gdb.guile/scm-type.c: New file.
* gdb.guile/scm-type.exp: New file.
* gdb.guile/scm-value-cc.cc: New file.
* gdb.guile/scm-value-cc.exp: New file.
* gdb.guile/scm-value.c: New file.
* gdb.guile/scm-value.exp: New file.
* gdb.guile/source2.scm: New file.
* gdb.guile/types-module.cc: New file.
* gdb.guile/types-module.exp: New file.
2014-02-10 04:40:01 +01:00
|
|
|
|
/* General utility routines for GDB/Scheme code.
|
|
|
|
|
|
|
|
|
|
Copyright (C) 2014 Free Software Foundation, Inc.
|
|
|
|
|
|
|
|
|
|
This file is part of GDB.
|
|
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
|
the Free Software Foundation; either version 3 of the License, or
|
|
|
|
|
(at your option) any later version.
|
|
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
|
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>. */
|
|
|
|
|
|
|
|
|
|
/* See README file in this directory for implementation notes, coding
|
|
|
|
|
conventions, et.al. */
|
|
|
|
|
|
|
|
|
|
#include "defs.h"
|
|
|
|
|
#include <stdarg.h>
|
|
|
|
|
#include <stdint.h>
|
|
|
|
|
#include "gdb_assert.h"
|
|
|
|
|
#include "guile-internal.h"
|
|
|
|
|
|
|
|
|
|
/* Define VARIABLES in the gdb module. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_define_variables (const scheme_variable *variables, int public)
|
|
|
|
|
{
|
|
|
|
|
const scheme_variable *sv;
|
|
|
|
|
|
|
|
|
|
for (sv = variables; sv->name != NULL; ++sv)
|
|
|
|
|
{
|
|
|
|
|
scm_c_define (sv->name, sv->value);
|
|
|
|
|
if (public)
|
|
|
|
|
scm_c_export (sv->name, NULL);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Define FUNCTIONS in the gdb module. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_define_functions (const scheme_function *functions, int public)
|
|
|
|
|
{
|
|
|
|
|
const scheme_function *sf;
|
|
|
|
|
|
|
|
|
|
for (sf = functions; sf->name != NULL; ++sf)
|
|
|
|
|
{
|
|
|
|
|
SCM proc = scm_c_define_gsubr (sf->name, sf->required, sf->optional,
|
|
|
|
|
sf->rest, sf->func);
|
|
|
|
|
|
|
|
|
|
scm_set_procedure_property_x (proc, gdbscm_documentation_symbol,
|
|
|
|
|
gdbscm_scm_from_c_string (sf->doc_string));
|
|
|
|
|
if (public)
|
|
|
|
|
scm_c_export (sf->name, NULL);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Define CONSTANTS in the gdb module. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_define_integer_constants (const scheme_integer_constant *constants,
|
|
|
|
|
int public)
|
|
|
|
|
{
|
|
|
|
|
const scheme_integer_constant *sc;
|
|
|
|
|
|
|
|
|
|
for (sc = constants; sc->name != NULL; ++sc)
|
|
|
|
|
{
|
|
|
|
|
scm_c_define (sc->name, scm_from_int (sc->value));
|
|
|
|
|
if (public)
|
|
|
|
|
scm_c_export (sc->name, NULL);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* scm_printf, alas it doesn't exist. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_printf (SCM port, const char *format, ...)
|
|
|
|
|
{
|
|
|
|
|
va_list args;
|
|
|
|
|
char *string;
|
|
|
|
|
|
|
|
|
|
va_start (args, format);
|
|
|
|
|
string = xstrvprintf (format, args);
|
|
|
|
|
va_end (args);
|
|
|
|
|
scm_puts (string, port);
|
|
|
|
|
xfree (string);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Utility for calling from gdb to "display" an SCM object. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_debug_display (SCM obj)
|
|
|
|
|
{
|
|
|
|
|
SCM port = scm_current_output_port ();
|
|
|
|
|
|
|
|
|
|
scm_display (obj, port);
|
|
|
|
|
scm_newline (port);
|
|
|
|
|
scm_force_output (port);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Utility for calling from gdb to "write" an SCM object. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_debug_write (SCM obj)
|
|
|
|
|
{
|
|
|
|
|
SCM port = scm_current_output_port ();
|
|
|
|
|
|
|
|
|
|
scm_write (obj, port);
|
|
|
|
|
scm_newline (port);
|
|
|
|
|
scm_force_output (port);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Subroutine of gdbscm_parse_function_args to simplify it.
|
|
|
|
|
Return the number of keyword arguments. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
count_keywords (const SCM *keywords)
|
|
|
|
|
{
|
|
|
|
|
int i;
|
|
|
|
|
|
|
|
|
|
if (keywords == NULL)
|
|
|
|
|
return 0;
|
|
|
|
|
for (i = 0; keywords[i] != SCM_BOOL_F; ++i)
|
|
|
|
|
continue;
|
|
|
|
|
|
|
|
|
|
return i;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Subroutine of gdbscm_parse_function_args to simplify it.
|
|
|
|
|
Validate an argument format string.
|
|
|
|
|
The result is a boolean indicating if "." was seen. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
validate_arg_format (const char *format)
|
|
|
|
|
{
|
|
|
|
|
const char *p;
|
|
|
|
|
int length = strlen (format);
|
|
|
|
|
int optional_position = -1;
|
|
|
|
|
int keyword_position = -1;
|
|
|
|
|
int dot_seen = 0;
|
|
|
|
|
|
|
|
|
|
gdb_assert (length > 0);
|
|
|
|
|
|
|
|
|
|
for (p = format; *p != '\0'; ++p)
|
|
|
|
|
{
|
|
|
|
|
switch (*p)
|
|
|
|
|
{
|
|
|
|
|
case 's':
|
|
|
|
|
case 't':
|
|
|
|
|
case 'i':
|
|
|
|
|
case 'u':
|
|
|
|
|
case 'l':
|
|
|
|
|
case 'n':
|
|
|
|
|
case 'L':
|
|
|
|
|
case 'U':
|
|
|
|
|
case 'O':
|
|
|
|
|
break;
|
|
|
|
|
case '|':
|
|
|
|
|
gdb_assert (keyword_position < 0);
|
|
|
|
|
gdb_assert (optional_position < 0);
|
|
|
|
|
optional_position = p - format;
|
|
|
|
|
break;
|
|
|
|
|
case '#':
|
|
|
|
|
gdb_assert (keyword_position < 0);
|
|
|
|
|
keyword_position = p - format;
|
|
|
|
|
break;
|
|
|
|
|
case '.':
|
|
|
|
|
gdb_assert (p[1] == '\0');
|
|
|
|
|
dot_seen = 1;
|
|
|
|
|
break;
|
|
|
|
|
default:
|
|
|
|
|
gdb_assert_not_reached ("invalid argument format character");
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return dot_seen;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Our version of SCM_ASSERT_TYPE that calls gdbscm_make_type_error. */
|
|
|
|
|
#define CHECK_TYPE(ok, arg, position, func_name, expected_type) \
|
|
|
|
|
do { \
|
|
|
|
|
if (!(ok)) \
|
|
|
|
|
{ \
|
|
|
|
|
return gdbscm_make_type_error ((func_name), (position), (arg), \
|
|
|
|
|
(expected_type)); \
|
|
|
|
|
} \
|
|
|
|
|
} while (0)
|
|
|
|
|
|
|
|
|
|
/* Subroutine of gdbscm_parse_function_args to simplify it.
|
|
|
|
|
Check the type of ARG against FORMAT_CHAR and extract the value.
|
|
|
|
|
POSITION is the position of ARG in the argument list.
|
|
|
|
|
The result is #f upon success or a <gdb:exception> object. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
extract_arg (char format_char, SCM arg, void *argp,
|
|
|
|
|
const char *func_name, int position)
|
|
|
|
|
{
|
|
|
|
|
switch (format_char)
|
|
|
|
|
{
|
|
|
|
|
case 's':
|
|
|
|
|
{
|
|
|
|
|
char **arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position,
|
|
|
|
|
func_name, _("string"));
|
|
|
|
|
*arg_ptr = gdbscm_scm_to_c_string (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 't':
|
|
|
|
|
{
|
|
|
|
|
int *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
/* While in Scheme, anything non-#f is "true", we're strict. */
|
|
|
|
|
CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name,
|
|
|
|
|
_("boolean"));
|
|
|
|
|
*arg_ptr = gdbscm_is_true (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 'i':
|
|
|
|
|
{
|
|
|
|
|
int *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX),
|
|
|
|
|
arg, position, func_name, _("int"));
|
|
|
|
|
*arg_ptr = scm_to_int (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 'u':
|
|
|
|
|
{
|
|
|
|
|
int *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX),
|
|
|
|
|
arg, position, func_name, _("unsigned int"));
|
|
|
|
|
*arg_ptr = scm_to_uint (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 'l':
|
|
|
|
|
{
|
|
|
|
|
long *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX),
|
|
|
|
|
arg, position, func_name, _("long"));
|
|
|
|
|
*arg_ptr = scm_to_long (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 'n':
|
|
|
|
|
{
|
|
|
|
|
unsigned long *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX),
|
|
|
|
|
arg, position, func_name, _("unsigned long"));
|
|
|
|
|
*arg_ptr = scm_to_ulong (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 'L':
|
|
|
|
|
{
|
|
|
|
|
LONGEST *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX),
|
|
|
|
|
arg, position, func_name, _("LONGEST"));
|
|
|
|
|
*arg_ptr = gdbscm_scm_to_longest (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 'U':
|
|
|
|
|
{
|
|
|
|
|
ULONGEST *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX),
|
|
|
|
|
arg, position, func_name, _("ULONGEST"));
|
|
|
|
|
*arg_ptr = gdbscm_scm_to_ulongest (arg);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
case 'O':
|
|
|
|
|
{
|
|
|
|
|
SCM *arg_ptr = argp;
|
|
|
|
|
|
|
|
|
|
*arg_ptr = arg;
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
default:
|
|
|
|
|
gdb_assert_not_reached ("invalid argument format character");
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#undef CHECK_TYPE
|
|
|
|
|
|
|
|
|
|
/* Look up KEYWORD in KEYWORD_LIST.
|
|
|
|
|
The result is the index of the keyword in the list or -1 if not found. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
lookup_keyword (const SCM *keyword_list, SCM keyword)
|
|
|
|
|
{
|
|
|
|
|
int i = 0;
|
|
|
|
|
|
|
|
|
|
while (keyword_list[i] != SCM_BOOL_F)
|
|
|
|
|
{
|
|
|
|
|
if (scm_is_eq (keyword_list[i], keyword))
|
|
|
|
|
return i;
|
|
|
|
|
++i;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return -1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Utility to parse required, optional, and keyword arguments to Scheme
|
|
|
|
|
functions. Modelled on PyArg_ParseTupleAndKeywords, but no attempt is made
|
|
|
|
|
at similarity or functionality.
|
|
|
|
|
There is no result, if there's an error a Scheme exception is thrown.
|
|
|
|
|
|
|
|
|
|
Guile provides scm_c_bind_keyword_arguments, and feel free to use it.
|
|
|
|
|
This is for times when we want a bit more parsing.
|
|
|
|
|
|
|
|
|
|
BEGINNING_ARG_POS is the position of the first argument passed to this
|
|
|
|
|
routine. It should be one of the SCM_ARGn values. It could be > SCM_ARG1
|
|
|
|
|
if the caller chooses not to parse one or more required arguments.
|
|
|
|
|
|
|
|
|
|
KEYWORDS may be NULL if there are no keywords.
|
|
|
|
|
|
|
|
|
|
FORMAT:
|
|
|
|
|
s - string -> char *, malloc'd
|
|
|
|
|
t - boolean (gdb uses "t", for biT?) -> int
|
|
|
|
|
i - int
|
|
|
|
|
u - unsigned int
|
|
|
|
|
l - long
|
|
|
|
|
n - unsigned long
|
|
|
|
|
L - longest
|
|
|
|
|
U - unsigned longest
|
|
|
|
|
O - random scheme object
|
|
|
|
|
| - indicates the next set is for optional arguments
|
|
|
|
|
# - indicates the next set is for keyword arguments (must follow |)
|
|
|
|
|
. - indicates "rest" arguments are present, this character must appear last
|
|
|
|
|
|
|
|
|
|
FORMAT must match the definition from scm_c_{make,define}_gsubr.
|
|
|
|
|
Required and optional arguments appear in order in the format string.
|
|
|
|
|
Afterwards, keyword-based arguments are processed. There must be as many
|
|
|
|
|
remaining characters in the format string as their are keywords.
|
|
|
|
|
Except for "|#.", the number of characters in the format string must match
|
|
|
|
|
#required + #optional + #keywords.
|
|
|
|
|
|
|
|
|
|
The function is required to be defined in a compatible manner:
|
|
|
|
|
#required-args and #optional-arguments must match, and rest-arguments
|
|
|
|
|
must be specified if keyword args are desired, and/or regular "rest" args.
|
|
|
|
|
|
|
|
|
|
Example: For this function,
|
|
|
|
|
scm_c_define_gsubr ("execute", 2, 3, 1, foo);
|
|
|
|
|
the format string + keyword list could be any of:
|
|
|
|
|
1) "ss|ttt#tt", { "key1", "key2", NULL }
|
|
|
|
|
2) "ss|ttt.", { NULL }
|
|
|
|
|
3) "ss|ttt#t.", { "key1", NULL }
|
|
|
|
|
|
|
|
|
|
For required and optional args pass the SCM of the argument, and a
|
|
|
|
|
pointer to the value to hold the parsed result (type depends on format
|
|
|
|
|
char). After that pass the SCM containing the "rest" arguments followed
|
|
|
|
|
by pointers to values to hold parsed keyword arguments, and if specified
|
|
|
|
|
a pointer to hold the remaining contents of "rest".
|
|
|
|
|
|
|
|
|
|
For keyword arguments pass two pointers: the first is a pointer to an int
|
|
|
|
|
that will contain the position of the argument in the arg list, and the
|
|
|
|
|
second will contain result of processing the argument. The int pointed
|
|
|
|
|
to by the first value should be initialized to -1. It can then be used
|
|
|
|
|
to tell whether the keyword was present.
|
|
|
|
|
|
|
|
|
|
If both keyword and rest arguments are present, the caller must pass a
|
|
|
|
|
pointer to contain the new value of rest (after keyword args have been
|
|
|
|
|
removed).
|
|
|
|
|
|
|
|
|
|
There's currently no way, that I know of, to specify default values for
|
|
|
|
|
optional arguments in C-provided functions. At the moment they're a
|
|
|
|
|
work-in-progress. The caller should test SCM_UNBNDP for each optional
|
|
|
|
|
argument. Unbound optional arguments are ignored. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_parse_function_args (const char *func_name,
|
|
|
|
|
int beginning_arg_pos,
|
|
|
|
|
const SCM *keywords,
|
|
|
|
|
const char *format, ...)
|
|
|
|
|
{
|
|
|
|
|
va_list args;
|
|
|
|
|
const char *p;
|
|
|
|
|
int i, have_rest, num_keywords, length, position;
|
|
|
|
|
int have_optional = 0;
|
|
|
|
|
SCM status;
|
|
|
|
|
SCM rest = SCM_EOL;
|
|
|
|
|
/* Keep track of malloc'd strings. We need to free them upon error. */
|
|
|
|
|
VEC (char_ptr) *allocated_strings = NULL;
|
|
|
|
|
char *ptr;
|
|
|
|
|
|
|
|
|
|
have_rest = validate_arg_format (format);
|
|
|
|
|
num_keywords = count_keywords (keywords);
|
|
|
|
|
|
|
|
|
|
va_start (args, format);
|
|
|
|
|
|
|
|
|
|
p = format;
|
|
|
|
|
position = beginning_arg_pos;
|
|
|
|
|
|
|
|
|
|
/* Process required, optional arguments. */
|
|
|
|
|
|
|
|
|
|
while (*p && *p != '#' && *p != '.')
|
|
|
|
|
{
|
|
|
|
|
SCM arg;
|
|
|
|
|
void *arg_ptr;
|
|
|
|
|
|
|
|
|
|
if (*p == '|')
|
|
|
|
|
{
|
|
|
|
|
have_optional = 1;
|
|
|
|
|
++p;
|
|
|
|
|
continue;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
arg = va_arg (args, SCM);
|
|
|
|
|
if (!have_optional || !SCM_UNBNDP (arg))
|
|
|
|
|
{
|
|
|
|
|
arg_ptr = va_arg (args, void *);
|
|
|
|
|
status = extract_arg (*p, arg, arg_ptr, func_name, position);
|
|
|
|
|
if (!gdbscm_is_false (status))
|
|
|
|
|
goto fail;
|
|
|
|
|
if (*p == 's')
|
|
|
|
|
VEC_safe_push (char_ptr, allocated_strings, *(char **) arg_ptr);
|
|
|
|
|
}
|
|
|
|
|
++p;
|
|
|
|
|
++position;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Process keyword arguments. */
|
|
|
|
|
|
|
|
|
|
if (have_rest || num_keywords > 0)
|
|
|
|
|
rest = va_arg (args, SCM);
|
|
|
|
|
|
|
|
|
|
if (num_keywords > 0)
|
|
|
|
|
{
|
|
|
|
|
SCM *keyword_args = (SCM *) alloca (num_keywords * sizeof (SCM));
|
|
|
|
|
int *keyword_positions = (int *) alloca (num_keywords * sizeof (int));
|
|
|
|
|
|
|
|
|
|
gdb_assert (*p == '#');
|
|
|
|
|
++p;
|
|
|
|
|
|
|
|
|
|
for (i = 0; i < num_keywords; ++i)
|
|
|
|
|
{
|
|
|
|
|
keyword_args[i] = SCM_UNSPECIFIED;
|
|
|
|
|
keyword_positions[i] = -1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
while (scm_is_pair (rest)
|
|
|
|
|
&& scm_is_keyword (scm_car (rest)))
|
|
|
|
|
{
|
|
|
|
|
SCM keyword = scm_car (rest);
|
|
|
|
|
|
|
|
|
|
i = lookup_keyword (keywords, keyword);
|
|
|
|
|
if (i < 0)
|
|
|
|
|
{
|
|
|
|
|
status = gdbscm_make_error (scm_arg_type_key, func_name,
|
|
|
|
|
_("Unrecognized keyword: ~a"),
|
|
|
|
|
scm_list_1 (keyword), keyword);
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
|
|
|
|
if (!scm_is_pair (scm_cdr (rest)))
|
|
|
|
|
{
|
|
|
|
|
status = gdbscm_make_error
|
|
|
|
|
(scm_arg_type_key, func_name,
|
|
|
|
|
_("Missing value for keyword argument"),
|
|
|
|
|
scm_list_1 (keyword), keyword);
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
|
|
|
|
keyword_args[i] = scm_cadr (rest);
|
|
|
|
|
keyword_positions[i] = position + 1;
|
|
|
|
|
rest = scm_cddr (rest);
|
|
|
|
|
position += 2;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
for (i = 0; i < num_keywords; ++i)
|
|
|
|
|
{
|
|
|
|
|
int *arg_pos_ptr = va_arg (args, int *);
|
|
|
|
|
void *arg_ptr = va_arg (args, void *);
|
|
|
|
|
SCM arg = keyword_args[i];
|
|
|
|
|
|
|
|
|
|
if (! scm_is_eq (arg, SCM_UNSPECIFIED))
|
|
|
|
|
{
|
|
|
|
|
*arg_pos_ptr = keyword_positions[i];
|
|
|
|
|
status = extract_arg (p[i], arg, arg_ptr, func_name,
|
|
|
|
|
keyword_positions[i]);
|
|
|
|
|
if (!gdbscm_is_false (status))
|
|
|
|
|
goto fail;
|
|
|
|
|
if (p[i] == 's')
|
|
|
|
|
{
|
|
|
|
|
VEC_safe_push (char_ptr, allocated_strings,
|
|
|
|
|
*(char **) arg_ptr);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Process "rest" arguments. */
|
|
|
|
|
|
|
|
|
|
if (have_rest)
|
|
|
|
|
{
|
|
|
|
|
if (num_keywords > 0)
|
|
|
|
|
{
|
|
|
|
|
SCM *rest_ptr = va_arg (args, SCM *);
|
|
|
|
|
|
|
|
|
|
*rest_ptr = rest;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
if (! scm_is_null (rest))
|
|
|
|
|
{
|
|
|
|
|
status = gdbscm_make_error (scm_args_number_key, func_name,
|
|
|
|
|
_("Too many arguments"),
|
|
|
|
|
SCM_EOL, SCM_BOOL_F);
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
va_end (args);
|
|
|
|
|
VEC_free (char_ptr, allocated_strings);
|
|
|
|
|
return;
|
|
|
|
|
|
|
|
|
|
fail:
|
|
|
|
|
va_end (args);
|
|
|
|
|
for (i = 0; VEC_iterate (char_ptr, allocated_strings, i, ptr); ++i)
|
|
|
|
|
xfree (ptr);
|
|
|
|
|
VEC_free (char_ptr, allocated_strings);
|
|
|
|
|
gdbscm_throw (status);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return longest L as a scheme object. */
|
|
|
|
|
|
|
|
|
|
SCM
|
|
|
|
|
gdbscm_scm_from_longest (LONGEST l)
|
|
|
|
|
{
|
|
|
|
|
return scm_from_int64 (l);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Convert scheme object L to LONGEST.
|
|
|
|
|
It is an error to call this if L is not an integer in range of LONGEST.
|
|
|
|
|
(because the underlying Scheme function will thrown an exception,
|
|
|
|
|
which is not part of our contract with the caller). */
|
|
|
|
|
|
|
|
|
|
LONGEST
|
|
|
|
|
gdbscm_scm_to_longest (SCM l)
|
|
|
|
|
{
|
|
|
|
|
return scm_to_int64 (l);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return unsigned longest L as a scheme object. */
|
|
|
|
|
|
|
|
|
|
SCM
|
|
|
|
|
gdbscm_scm_from_ulongest (ULONGEST l)
|
|
|
|
|
{
|
|
|
|
|
return scm_from_uint64 (l);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Convert scheme object U to ULONGEST.
|
|
|
|
|
It is an error to call this if U is not an integer in range of ULONGEST
|
|
|
|
|
(because the underlying Scheme function will thrown an exception,
|
|
|
|
|
which is not part of our contract with the caller). */
|
|
|
|
|
|
|
|
|
|
ULONGEST
|
|
|
|
|
gdbscm_scm_to_ulongest (SCM u)
|
|
|
|
|
{
|
|
|
|
|
return scm_to_uint64 (u);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Same as scm_dynwind_free, but uses xfree. */
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_dynwind_xfree (void *ptr)
|
|
|
|
|
{
|
|
|
|
|
scm_dynwind_unwind_handler (xfree, ptr, SCM_F_WIND_EXPLICITLY);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return non-zero if PROC is a procedure. */
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
|
gdbscm_is_procedure (SCM proc)
|
|
|
|
|
{
|
|
|
|
|
return gdbscm_is_true (scm_procedure_p (proc));
|
|
|
|
|
}
|
2014-06-03 09:29:49 +02:00
|
|
|
|
|
|
|
|
|
/* Same as xstrdup, but the string is allocated on the GC heap. */
|
|
|
|
|
|
|
|
|
|
char *
|
|
|
|
|
gdbscm_gc_xstrdup (const char *str)
|
|
|
|
|
{
|
|
|
|
|
size_t len = strlen (str);
|
|
|
|
|
char *result = scm_gc_malloc_pointerless (len + 1, "gdbscm_gc_xstrdup");
|
|
|
|
|
|
|
|
|
|
strcpy (result, str);
|
|
|
|
|
return result;
|
|
|
|
|
}
|
2014-06-03 10:58:15 +02:00
|
|
|
|
|
|
|
|
|
/* Return a duplicate of ARGV living on the GC heap. */
|
|
|
|
|
|
|
|
|
|
const char * const *
|
|
|
|
|
gdbscm_gc_dup_argv (char **argv)
|
|
|
|
|
{
|
|
|
|
|
int i, len;
|
|
|
|
|
size_t string_space;
|
|
|
|
|
char *p, **result;
|
|
|
|
|
|
|
|
|
|
for (len = 0, string_space = 0; argv[len] != NULL; ++len)
|
|
|
|
|
string_space += strlen (argv[len]) + 1;
|
|
|
|
|
|
|
|
|
|
/* Allocating "pointerless" works because the pointers are all
|
|
|
|
|
self-contained within the object. */
|
|
|
|
|
result = scm_gc_malloc_pointerless (((len + 1) * sizeof (char *))
|
|
|
|
|
+ string_space, "parameter enum list");
|
|
|
|
|
p = (char *) &result[len + 1];
|
|
|
|
|
|
|
|
|
|
for (i = 0; i < len; ++i)
|
|
|
|
|
{
|
|
|
|
|
result[i] = p;
|
|
|
|
|
strcpy (p, argv[i]);
|
|
|
|
|
p += strlen (p) + 1;
|
|
|
|
|
}
|
|
|
|
|
result[i] = NULL;
|
|
|
|
|
|
|
|
|
|
return (const char * const *) result;
|
|
|
|
|
}
|
2014-06-07 00:57:03 +02:00
|
|
|
|
|
|
|
|
|
/* Return non-zero if the version of Guile being used it at least
|
|
|
|
|
MAJOR.MINOR.MICRO. */
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
|
gdbscm_guile_version_is_at_least (int major, int minor, int micro)
|
|
|
|
|
{
|
|
|
|
|
if (major > gdbscm_guile_major_version)
|
|
|
|
|
return 0;
|
|
|
|
|
if (major < gdbscm_guile_major_version)
|
|
|
|
|
return 1;
|
|
|
|
|
if (minor > gdbscm_guile_minor_version)
|
|
|
|
|
return 0;
|
|
|
|
|
if (minor < gdbscm_guile_minor_version)
|
|
|
|
|
return 1;
|
|
|
|
|
if (micro > gdbscm_guile_micro_version)
|
|
|
|
|
return 0;
|
|
|
|
|
return 1;
|
|
|
|
|
}
|