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
|
|
|
|
/* Scheme interface to types.
|
|
|
|
|
|
|
|
|
|
Copyright (C) 2008-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 "arch-utils.h"
|
|
|
|
|
#include "value.h"
|
|
|
|
|
#include "exceptions.h"
|
|
|
|
|
#include "gdbtypes.h"
|
|
|
|
|
#include "objfiles.h"
|
|
|
|
|
#include "language.h"
|
|
|
|
|
#include "vec.h"
|
|
|
|
|
#include "bcache.h"
|
|
|
|
|
#include "dwarf2loc.h"
|
|
|
|
|
#include "typeprint.h"
|
|
|
|
|
#include "guile-internal.h"
|
|
|
|
|
|
|
|
|
|
/* The <gdb:type> smob.
|
|
|
|
|
The type is chained with all types associated with its objfile, if any.
|
|
|
|
|
This lets us copy the underlying struct type when the objfile is
|
|
|
|
|
deleted. */
|
|
|
|
|
|
|
|
|
|
typedef struct _type_smob
|
|
|
|
|
{
|
|
|
|
|
/* This always appears first.
|
|
|
|
|
eqable_gdb_smob is used so that types are eq?-able.
|
|
|
|
|
Also, a type object can be associated with an objfile. eqable_gdb_smob
|
|
|
|
|
lets us track the lifetime of all types associated with an objfile.
|
|
|
|
|
When an objfile is deleted we need to invalidate the type object. */
|
|
|
|
|
eqable_gdb_smob base;
|
|
|
|
|
|
|
|
|
|
/* The GDB type structure this smob is wrapping. */
|
|
|
|
|
struct type *type;
|
|
|
|
|
} type_smob;
|
|
|
|
|
|
|
|
|
|
/* A field smob. */
|
|
|
|
|
|
|
|
|
|
typedef struct
|
|
|
|
|
{
|
|
|
|
|
/* This always appears first. */
|
|
|
|
|
gdb_smob base;
|
|
|
|
|
|
|
|
|
|
/* Backlink to the containing <gdb:type> object. */
|
|
|
|
|
SCM type_scm;
|
|
|
|
|
|
|
|
|
|
/* The field number in TYPE_SCM. */
|
|
|
|
|
int field_num;
|
|
|
|
|
} field_smob;
|
|
|
|
|
|
|
|
|
|
static const char type_smob_name[] = "gdb:type";
|
|
|
|
|
static const char field_smob_name[] = "gdb:field";
|
|
|
|
|
|
|
|
|
|
static const char not_composite_error[] =
|
|
|
|
|
N_("type is not a structure, union, or enum type");
|
|
|
|
|
|
|
|
|
|
/* The tag Guile knows the type smob by. */
|
|
|
|
|
static scm_t_bits type_smob_tag;
|
|
|
|
|
|
|
|
|
|
/* The tag Guile knows the field smob by. */
|
|
|
|
|
static scm_t_bits field_smob_tag;
|
|
|
|
|
|
|
|
|
|
/* The "next" procedure for field iterators. */
|
|
|
|
|
static SCM tyscm_next_field_x_proc;
|
|
|
|
|
|
|
|
|
|
/* Keywords used in argument passing. */
|
|
|
|
|
static SCM block_keyword;
|
|
|
|
|
|
|
|
|
|
static const struct objfile_data *tyscm_objfile_data_key;
|
|
|
|
|
|
|
|
|
|
/* Hash table to uniquify global (non-objfile-owned) types. */
|
|
|
|
|
static htab_t global_types_map;
|
|
|
|
|
|
|
|
|
|
static struct type *tyscm_get_composite (struct type *type);
|
|
|
|
|
|
|
|
|
|
/* Return the type field of T_SMOB.
|
|
|
|
|
This exists so that we don't have to export the struct's contents. */
|
|
|
|
|
|
|
|
|
|
struct type *
|
|
|
|
|
tyscm_type_smob_type (type_smob *t_smob)
|
|
|
|
|
{
|
|
|
|
|
return t_smob->type;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return the name of TYPE in expanded form.
|
|
|
|
|
Space for the result is malloc'd, caller must free.
|
|
|
|
|
If there's an error computing the name, the result is NULL and the
|
|
|
|
|
exception is stored in *EXCP. */
|
|
|
|
|
|
|
|
|
|
static char *
|
|
|
|
|
tyscm_type_name (struct type *type, SCM *excp)
|
|
|
|
|
{
|
|
|
|
|
char *name = NULL;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
struct cleanup *old_chain;
|
|
|
|
|
struct ui_file *stb;
|
|
|
|
|
|
|
|
|
|
stb = mem_fileopen ();
|
|
|
|
|
old_chain = make_cleanup_ui_file_delete (stb);
|
|
|
|
|
|
|
|
|
|
LA_PRINT_TYPE (type, "", stb, -1, 0, &type_print_raw_options);
|
|
|
|
|
|
|
|
|
|
name = ui_file_xstrdup (stb, NULL);
|
|
|
|
|
do_cleanups (old_chain);
|
|
|
|
|
}
|
|
|
|
|
if (except.reason < 0)
|
|
|
|
|
{
|
|
|
|
|
*excp = gdbscm_scm_from_gdb_exception (except);
|
|
|
|
|
return NULL;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return name;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Administrivia for type smobs. */
|
|
|
|
|
|
|
|
|
|
/* Helper function to hash a type_smob. */
|
|
|
|
|
|
|
|
|
|
static hashval_t
|
|
|
|
|
tyscm_hash_type_smob (const void *p)
|
|
|
|
|
{
|
|
|
|
|
const type_smob *t_smob = p;
|
|
|
|
|
|
|
|
|
|
return htab_hash_pointer (t_smob->type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Helper function to compute equality of type_smobs. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
tyscm_eq_type_smob (const void *ap, const void *bp)
|
|
|
|
|
{
|
|
|
|
|
const type_smob *a = ap;
|
|
|
|
|
const type_smob *b = bp;
|
|
|
|
|
|
|
|
|
|
return (a->type == b->type
|
|
|
|
|
&& a->type != NULL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return the struct type pointer -> SCM mapping table.
|
|
|
|
|
If type is owned by an objfile, the mapping table is created if necessary.
|
|
|
|
|
Otherwise, type is not owned by an objfile, and we use
|
|
|
|
|
global_types_map. */
|
|
|
|
|
|
|
|
|
|
static htab_t
|
|
|
|
|
tyscm_type_map (struct type *type)
|
|
|
|
|
{
|
|
|
|
|
struct objfile *objfile = TYPE_OBJFILE (type);
|
|
|
|
|
htab_t htab;
|
|
|
|
|
|
|
|
|
|
if (objfile == NULL)
|
|
|
|
|
return global_types_map;
|
|
|
|
|
|
|
|
|
|
htab = objfile_data (objfile, tyscm_objfile_data_key);
|
|
|
|
|
if (htab == NULL)
|
|
|
|
|
{
|
|
|
|
|
htab = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
|
|
|
|
|
tyscm_eq_type_smob);
|
|
|
|
|
set_objfile_data (objfile, tyscm_objfile_data_key, htab);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return htab;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* The smob "mark" function for <gdb:type>. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_mark_type_smob (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
|
|
|
|
|
|
|
|
|
|
/* Do this last. */
|
|
|
|
|
return gdbscm_mark_eqable_gsmob (&t_smob->base);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* The smob "free" function for <gdb:type>. */
|
|
|
|
|
|
|
|
|
|
static size_t
|
|
|
|
|
tyscm_free_type_smob (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
|
|
|
|
|
|
|
|
|
|
if (t_smob->type != NULL)
|
|
|
|
|
{
|
|
|
|
|
htab_t htab = tyscm_type_map (t_smob->type);
|
|
|
|
|
|
|
|
|
|
gdbscm_clear_eqable_gsmob_ptr_slot (htab, &t_smob->base);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Not necessary, done to catch bugs. */
|
|
|
|
|
t_smob->type = NULL;
|
|
|
|
|
|
|
|
|
|
return 0;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* The smob "print" function for <gdb:type>. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
tyscm_print_type_smob (SCM self, SCM port, scm_print_state *pstate)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
|
|
|
|
|
SCM exception;
|
|
|
|
|
char *name = tyscm_type_name (t_smob->type, &exception);
|
|
|
|
|
|
|
|
|
|
if (name == NULL)
|
|
|
|
|
gdbscm_throw (exception);
|
|
|
|
|
|
|
|
|
|
/* pstate->writingp = zero if invoked by display/~A, and nonzero if
|
|
|
|
|
invoked by write/~S. What to do here may need to evolve.
|
|
|
|
|
IWBN if we could pass an argument to format that would we could use
|
|
|
|
|
instead of writingp. */
|
|
|
|
|
if (pstate->writingp)
|
|
|
|
|
gdbscm_printf (port, "#<%s ", type_smob_name);
|
|
|
|
|
|
|
|
|
|
scm_puts (name, port);
|
|
|
|
|
|
|
|
|
|
if (pstate->writingp)
|
|
|
|
|
scm_puts (">", port);
|
|
|
|
|
|
|
|
|
|
scm_remember_upto_here_1 (self);
|
|
|
|
|
|
|
|
|
|
/* Non-zero means success. */
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* The smob "equal?" function for <gdb:type>. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_equal_p_type_smob (SCM type1_scm, SCM type2_scm)
|
|
|
|
|
{
|
|
|
|
|
type_smob *type1_smob, *type2_smob;
|
|
|
|
|
struct type *type1, *type2;
|
|
|
|
|
int result = 0;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (tyscm_is_type (type1_scm), type1_scm, SCM_ARG1, FUNC_NAME,
|
|
|
|
|
type_smob_name);
|
|
|
|
|
SCM_ASSERT_TYPE (tyscm_is_type (type2_scm), type2_scm, SCM_ARG2, FUNC_NAME,
|
|
|
|
|
type_smob_name);
|
|
|
|
|
type1_smob = (type_smob *) SCM_SMOB_DATA (type1_scm);
|
|
|
|
|
type2_smob = (type_smob *) SCM_SMOB_DATA (type2_scm);
|
|
|
|
|
type1 = type1_smob->type;
|
|
|
|
|
type2 = type2_smob->type;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
result = types_deeply_equal (type1, type2);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return scm_from_bool (result);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Low level routine to create a <gdb:type> object. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_make_type_smob (void)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob = (type_smob *)
|
|
|
|
|
scm_gc_malloc (sizeof (type_smob), type_smob_name);
|
|
|
|
|
SCM t_scm;
|
|
|
|
|
|
|
|
|
|
/* This must be filled in by the caller. */
|
|
|
|
|
t_smob->type = NULL;
|
|
|
|
|
|
|
|
|
|
t_scm = scm_new_smob (type_smob_tag, (scm_t_bits) t_smob);
|
2014-02-20 18:27:12 +01:00
|
|
|
|
gdbscm_init_eqable_gsmob (&t_smob->base, t_scm);
|
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
|
|
|
|
|
|
|
|
|
return t_scm;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return non-zero if SCM is a <gdb:type> object. */
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
|
tyscm_is_type (SCM self)
|
|
|
|
|
{
|
|
|
|
|
return SCM_SMOB_PREDICATE (type_smob_tag, self);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type? object) -> boolean */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_p (SCM self)
|
|
|
|
|
{
|
|
|
|
|
return scm_from_bool (tyscm_is_type (self));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return the existing object that encapsulates TYPE, or create a new
|
|
|
|
|
<gdb:type> object. */
|
|
|
|
|
|
|
|
|
|
SCM
|
|
|
|
|
tyscm_scm_from_type (struct type *type)
|
|
|
|
|
{
|
|
|
|
|
htab_t htab;
|
|
|
|
|
eqable_gdb_smob **slot;
|
|
|
|
|
type_smob *t_smob, t_smob_for_lookup;
|
|
|
|
|
SCM t_scm;
|
|
|
|
|
|
|
|
|
|
/* If we've already created a gsmob for this type, return it.
|
|
|
|
|
This makes types eq?-able. */
|
|
|
|
|
htab = tyscm_type_map (type);
|
|
|
|
|
t_smob_for_lookup.type = type;
|
|
|
|
|
slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &t_smob_for_lookup.base);
|
|
|
|
|
if (*slot != NULL)
|
|
|
|
|
return (*slot)->containing_scm;
|
|
|
|
|
|
|
|
|
|
t_scm = tyscm_make_type_smob ();
|
|
|
|
|
t_smob = (type_smob *) SCM_SMOB_DATA (t_scm);
|
|
|
|
|
t_smob->type = type;
|
2014-02-20 18:27:12 +01:00
|
|
|
|
gdbscm_fill_eqable_gsmob_ptr_slot (slot, &t_smob->base);
|
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
|
|
|
|
|
|
|
|
|
return t_scm;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns the <gdb:type> object in SELF.
|
|
|
|
|
Throws an exception if SELF is not a <gdb:type> object. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_get_type_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
SCM_ASSERT_TYPE (tyscm_is_type (self), self, arg_pos, func_name,
|
|
|
|
|
type_smob_name);
|
|
|
|
|
|
|
|
|
|
return self;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns a pointer to the type smob of SELF.
|
|
|
|
|
Throws an exception if SELF is not a <gdb:type> object. */
|
|
|
|
|
|
|
|
|
|
type_smob *
|
|
|
|
|
tyscm_get_type_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
SCM t_scm = tyscm_get_type_arg_unsafe (self, arg_pos, func_name);
|
|
|
|
|
type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (t_scm);
|
|
|
|
|
|
|
|
|
|
return t_smob;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Helper function for save_objfile_types to make a deep copy of the type. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
tyscm_copy_type_recursive (void **slot, void *info)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob = (type_smob *) *slot;
|
|
|
|
|
htab_t copied_types = info;
|
|
|
|
|
struct objfile *objfile = TYPE_OBJFILE (t_smob->type);
|
|
|
|
|
|
|
|
|
|
gdb_assert (objfile != NULL);
|
|
|
|
|
|
|
|
|
|
htab_empty (copied_types);
|
|
|
|
|
t_smob->type = copy_type_recursive (objfile, t_smob->type, copied_types);
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Called when OBJFILE is about to be deleted.
|
|
|
|
|
Make a copy of all types associated with OBJFILE. */
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
|
save_objfile_types (struct objfile *objfile, void *datum)
|
|
|
|
|
{
|
|
|
|
|
htab_t htab = datum;
|
|
|
|
|
htab_t copied_types;
|
|
|
|
|
|
|
|
|
|
if (!gdb_scheme_initialized)
|
|
|
|
|
return;
|
|
|
|
|
|
|
|
|
|
copied_types = create_copied_types_hash (objfile);
|
|
|
|
|
|
|
|
|
|
if (htab != NULL)
|
|
|
|
|
{
|
|
|
|
|
htab_traverse_noresize (htab, tyscm_copy_type_recursive, copied_types);
|
|
|
|
|
htab_delete (htab);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
htab_delete (copied_types);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Administrivia for field smobs. */
|
|
|
|
|
|
|
|
|
|
/* The smob "mark" function for <gdb:field>. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_mark_field_smob (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (self);
|
|
|
|
|
|
|
|
|
|
scm_gc_mark (f_smob->type_scm);
|
|
|
|
|
/* Do this last. */
|
|
|
|
|
return gdbscm_mark_gsmob (&f_smob->base);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* The smob "print" function for <gdb:field>. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
tyscm_print_field_smob (SCM self, SCM port, scm_print_state *pstate)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (self);
|
|
|
|
|
|
|
|
|
|
gdbscm_printf (port, "#<%s ", field_smob_name);
|
|
|
|
|
scm_write (f_smob->type_scm, port);
|
|
|
|
|
gdbscm_printf (port, " %d", f_smob->field_num);
|
|
|
|
|
scm_puts (">", port);
|
|
|
|
|
|
|
|
|
|
scm_remember_upto_here_1 (self);
|
|
|
|
|
|
|
|
|
|
/* Non-zero means success. */
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Low level routine to create a <gdb:field> object for field FIELD_NUM
|
|
|
|
|
of type TYPE_SCM. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_make_field_smob (SCM type_scm, int field_num)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob = (field_smob *)
|
|
|
|
|
scm_gc_malloc (sizeof (field_smob), field_smob_name);
|
|
|
|
|
SCM result;
|
|
|
|
|
|
|
|
|
|
f_smob->type_scm = type_scm;
|
|
|
|
|
f_smob->field_num = field_num;
|
|
|
|
|
result = scm_new_smob (field_smob_tag, (scm_t_bits) f_smob);
|
|
|
|
|
gdbscm_init_gsmob (&f_smob->base);
|
|
|
|
|
|
|
|
|
|
return result;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return non-zero if SCM is a <gdb:field> object. */
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
|
tyscm_is_field (SCM self)
|
|
|
|
|
{
|
|
|
|
|
return SCM_SMOB_PREDICATE (field_smob_tag, self);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (field? object) -> boolean */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_p (SCM self)
|
|
|
|
|
{
|
|
|
|
|
return scm_from_bool (tyscm_is_field (self));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Create a new <gdb:field> object that encapsulates field FIELD_NUM
|
|
|
|
|
in type TYPE_SCM. */
|
|
|
|
|
|
|
|
|
|
SCM
|
|
|
|
|
tyscm_scm_from_field (SCM type_scm, int field_num)
|
|
|
|
|
{
|
|
|
|
|
return tyscm_make_field_smob (type_scm, field_num);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns the <gdb:field> object in SELF.
|
|
|
|
|
Throws an exception if SELF is not a <gdb:field> object. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_get_field_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
SCM_ASSERT_TYPE (tyscm_is_field (self), self, arg_pos, func_name,
|
|
|
|
|
field_smob_name);
|
|
|
|
|
|
|
|
|
|
return self;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns a pointer to the field smob of SELF.
|
|
|
|
|
Throws an exception if SELF is not a <gdb:field> object. */
|
|
|
|
|
|
|
|
|
|
static field_smob *
|
|
|
|
|
tyscm_get_field_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
SCM f_scm = tyscm_get_field_arg_unsafe (self, arg_pos, func_name);
|
|
|
|
|
field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (f_scm);
|
|
|
|
|
|
|
|
|
|
return f_smob;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns a pointer to the type struct in F_SMOB
|
|
|
|
|
(the type the field is in). */
|
|
|
|
|
|
|
|
|
|
static struct type *
|
|
|
|
|
tyscm_field_smob_containing_type (field_smob *f_smob)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob;
|
|
|
|
|
|
|
|
|
|
gdb_assert (tyscm_is_type (f_smob->type_scm));
|
|
|
|
|
t_smob = (type_smob *) SCM_SMOB_DATA (f_smob->type_scm);
|
|
|
|
|
|
|
|
|
|
return t_smob->type;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Returns a pointer to the field struct of F_SMOB. */
|
|
|
|
|
|
|
|
|
|
static struct field *
|
|
|
|
|
tyscm_field_smob_to_field (field_smob *f_smob)
|
|
|
|
|
{
|
|
|
|
|
struct type *type = tyscm_field_smob_containing_type (f_smob);
|
|
|
|
|
|
|
|
|
|
/* This should be non-NULL by construction. */
|
|
|
|
|
gdb_assert (TYPE_FIELDS (type) != NULL);
|
|
|
|
|
|
|
|
|
|
return &TYPE_FIELD (type, f_smob->field_num);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Type smob accessors. */
|
|
|
|
|
|
|
|
|
|
/* (type-code <gdb:type>) -> integer
|
|
|
|
|
Return the code for this type. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_code (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
|
|
|
|
|
return scm_from_int (TYPE_CODE (type));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-fields <gdb:type>) -> list
|
|
|
|
|
Return a list of all fields. Each element is a <gdb:field> object.
|
|
|
|
|
This also supports arrays, we return a field list of one element,
|
|
|
|
|
the range type. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_fields (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
struct type *containing_type;
|
|
|
|
|
SCM containing_type_scm, result;
|
|
|
|
|
int i;
|
|
|
|
|
|
|
|
|
|
containing_type = tyscm_get_composite (type);
|
|
|
|
|
if (containing_type == NULL)
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
|
|
|
|
|
_(not_composite_error));
|
|
|
|
|
|
|
|
|
|
/* If SELF is a typedef or reference, we want the underlying type,
|
|
|
|
|
which is what tyscm_get_composite returns. */
|
|
|
|
|
if (containing_type == type)
|
|
|
|
|
containing_type_scm = self;
|
|
|
|
|
else
|
|
|
|
|
containing_type_scm = tyscm_scm_from_type (containing_type);
|
|
|
|
|
|
|
|
|
|
result = SCM_EOL;
|
|
|
|
|
for (i = 0; i < TYPE_NFIELDS (containing_type); ++i)
|
|
|
|
|
result = scm_cons (tyscm_make_field_smob (containing_type_scm, i), result);
|
|
|
|
|
|
|
|
|
|
return scm_reverse_x (result, SCM_EOL);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-tag <gdb:type>) -> string
|
|
|
|
|
Return the type's tag, or #f. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_tag (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
|
|
|
|
|
if (!TYPE_TAG_NAME (type))
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
return gdbscm_scm_from_c_string (TYPE_TAG_NAME (type));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-name <gdb:type>) -> string
|
|
|
|
|
Return the type's name, or #f. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_name (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
|
|
|
|
|
if (!TYPE_NAME (type))
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
return gdbscm_scm_from_c_string (TYPE_NAME (type));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-print-name <gdb:type>) -> string
|
|
|
|
|
Return the print name of type.
|
|
|
|
|
TODO: template support elided for now. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_print_name (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
char *thetype;
|
|
|
|
|
SCM exception, result;
|
|
|
|
|
|
|
|
|
|
thetype = tyscm_type_name (type, &exception);
|
|
|
|
|
|
|
|
|
|
if (thetype == NULL)
|
|
|
|
|
gdbscm_throw (exception);
|
|
|
|
|
|
|
|
|
|
result = gdbscm_scm_from_c_string (thetype);
|
|
|
|
|
xfree (thetype);
|
|
|
|
|
|
|
|
|
|
return result;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-sizeof <gdb:type>) -> integer
|
|
|
|
|
Return the size of the type represented by SELF, in bytes. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_sizeof (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
check_typedef (type);
|
|
|
|
|
}
|
|
|
|
|
/* Ignore exceptions. */
|
|
|
|
|
|
|
|
|
|
return scm_from_long (TYPE_LENGTH (type));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-strip-typedefs <gdb:type>) -> <gdb:type>
|
|
|
|
|
Return the type, stripped of typedefs. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_strip_typedefs (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
type = check_typedef (type);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Strip typedefs and pointers/reference from a type. Then check that
|
|
|
|
|
it is a struct, union, or enum type. If not, return NULL. */
|
|
|
|
|
|
|
|
|
|
static struct type *
|
|
|
|
|
tyscm_get_composite (struct type *type)
|
|
|
|
|
{
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
for (;;)
|
|
|
|
|
{
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
type = check_typedef (type);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
if (TYPE_CODE (type) != TYPE_CODE_PTR
|
|
|
|
|
&& TYPE_CODE (type) != TYPE_CODE_REF)
|
|
|
|
|
break;
|
|
|
|
|
type = TYPE_TARGET_TYPE (type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* If this is not a struct, union, or enum type, raise TypeError
|
|
|
|
|
exception. */
|
|
|
|
|
if (TYPE_CODE (type) != TYPE_CODE_STRUCT
|
|
|
|
|
&& TYPE_CODE (type) != TYPE_CODE_UNION
|
|
|
|
|
&& TYPE_CODE (type) != TYPE_CODE_ENUM)
|
|
|
|
|
return NULL;
|
|
|
|
|
|
|
|
|
|
return type;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Helper for tyscm_array and tyscm_vector. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
tyscm_array_1 (SCM self, SCM n1_scm, SCM n2_scm, int is_vector,
|
|
|
|
|
const char *func_name)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, func_name);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
long n1, n2 = 0;
|
|
|
|
|
struct type *array = NULL;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
gdbscm_parse_function_args (func_name, SCM_ARG2, NULL, "l|l",
|
|
|
|
|
n1_scm, &n1, n2_scm, &n2);
|
|
|
|
|
|
|
|
|
|
if (SCM_UNBNDP (n2_scm))
|
|
|
|
|
{
|
|
|
|
|
n2 = n1;
|
|
|
|
|
n1 = 0;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if (n2 < n1)
|
|
|
|
|
{
|
|
|
|
|
gdbscm_out_of_range_error (func_name, SCM_ARG3,
|
|
|
|
|
scm_cons (scm_from_long (n1),
|
|
|
|
|
scm_from_long (n2)),
|
|
|
|
|
_("Array length must not be negative"));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
array = lookup_array_range_type (type, n1, n2);
|
|
|
|
|
if (is_vector)
|
|
|
|
|
make_vector_type (array);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (array);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-array <gdb:type> [low-bound] high-bound) -> <gdb:type>
|
|
|
|
|
The array has indices [low-bound,high-bound].
|
|
|
|
|
If low-bound is not provided zero is used.
|
|
|
|
|
Return an array type.
|
|
|
|
|
|
|
|
|
|
IWBN if the one argument version specified a size, not the high bound.
|
|
|
|
|
It's too easy to pass one argument thinking it is the size of the array.
|
|
|
|
|
The current semantics are for compatibility with the Python version.
|
|
|
|
|
Later we can add #:size. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_array (SCM self, SCM n1, SCM n2)
|
|
|
|
|
{
|
|
|
|
|
return tyscm_array_1 (self, n1, n2, 0, FUNC_NAME);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-vector <gdb:type> [low-bound] high-bound) -> <gdb:type>
|
|
|
|
|
The array has indices [low-bound,high-bound].
|
|
|
|
|
If low-bound is not provided zero is used.
|
|
|
|
|
Return a vector type.
|
|
|
|
|
|
|
|
|
|
IWBN if the one argument version specified a size, not the high bound.
|
|
|
|
|
It's too easy to pass one argument thinking it is the size of the array.
|
|
|
|
|
The current semantics are for compatibility with the Python version.
|
|
|
|
|
Later we can add #:size. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_vector (SCM self, SCM n1, SCM n2)
|
|
|
|
|
{
|
|
|
|
|
return tyscm_array_1 (self, n1, n2, 1, FUNC_NAME);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-pointer <gdb:type>) -> <gdb:type>
|
|
|
|
|
Return a <gdb:type> object which represents a pointer to SELF. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_pointer (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
type = lookup_pointer_type (type);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-range <gdb:type>) -> (low high)
|
|
|
|
|
Return the range of a type represented by SELF. The return type is
|
|
|
|
|
a list. The first element is the low bound, and the second element
|
|
|
|
|
is the high bound. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_range (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
SCM low_scm, high_scm;
|
|
|
|
|
/* Initialize these to appease GCC warnings. */
|
|
|
|
|
LONGEST low = 0, high = 0;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (TYPE_CODE (type) == TYPE_CODE_ARRAY
|
|
|
|
|
|| TYPE_CODE (type) == TYPE_CODE_STRING
|
|
|
|
|
|| TYPE_CODE (type) == TYPE_CODE_RANGE,
|
|
|
|
|
self, SCM_ARG1, FUNC_NAME, _("ranged type"));
|
|
|
|
|
|
|
|
|
|
switch (TYPE_CODE (type))
|
|
|
|
|
{
|
|
|
|
|
case TYPE_CODE_ARRAY:
|
|
|
|
|
case TYPE_CODE_STRING:
|
|
|
|
|
low = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type));
|
|
|
|
|
high = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (type));
|
|
|
|
|
break;
|
|
|
|
|
case TYPE_CODE_RANGE:
|
|
|
|
|
low = TYPE_LOW_BOUND (type);
|
|
|
|
|
high = TYPE_HIGH_BOUND (type);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
low_scm = gdbscm_scm_from_longest (low);
|
|
|
|
|
high_scm = gdbscm_scm_from_longest (high);
|
|
|
|
|
|
|
|
|
|
return scm_list_2 (low_scm, high_scm);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-reference <gdb:type>) -> <gdb:type>
|
|
|
|
|
Return a <gdb:type> object which represents a reference to SELF. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_reference (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
type = lookup_reference_type (type);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-target <gdb:type>) -> <gdb:type>
|
|
|
|
|
Return a <gdb:type> object which represents the target type of SELF. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_target (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT (TYPE_TARGET_TYPE (type), self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (TYPE_TARGET_TYPE (type));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-const <gdb:type>) -> <gdb:type>
|
|
|
|
|
Return a const-qualified type variant. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_const (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
type = make_cv_type (1, 0, type, NULL);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-volatile <gdb:type>) -> <gdb:type>
|
|
|
|
|
Return a volatile-qualified type variant. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_volatile (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
type = make_cv_type (0, 1, type, NULL);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-unqualified <gdb:type>) -> <gdb:type>
|
|
|
|
|
Return an unqualified type variant. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_unqualified (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
type = make_cv_type (0, 0, type, NULL);
|
|
|
|
|
}
|
|
|
|
|
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
|
|
|
|
|
|
|
|
|
return tyscm_scm_from_type (type);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Field related accessors of types. */
|
|
|
|
|
|
|
|
|
|
/* (type-num-fields <gdb:type>) -> integer
|
|
|
|
|
Return number of fields. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_num_fields (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
|
|
|
|
|
type = tyscm_get_composite (type);
|
|
|
|
|
if (type == NULL)
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
|
|
|
|
|
_(not_composite_error));
|
|
|
|
|
|
|
|
|
|
return scm_from_long (TYPE_NFIELDS (type));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-field <gdb:type> string) -> <gdb:field>
|
|
|
|
|
Return the <gdb:field> object for the field named by the argument. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_field (SCM self, SCM field_scm)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
char *field;
|
|
|
|
|
int i;
|
|
|
|
|
struct cleanup *cleanups;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
|
|
|
|
_("string"));
|
|
|
|
|
|
|
|
|
|
/* We want just fields of this type, not of base types, so instead of
|
|
|
|
|
using lookup_struct_elt_type, portions of that function are
|
|
|
|
|
copied here. */
|
|
|
|
|
|
|
|
|
|
type = tyscm_get_composite (type);
|
|
|
|
|
if (type == NULL)
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
|
|
|
|
|
_(not_composite_error));
|
|
|
|
|
|
|
|
|
|
field = gdbscm_scm_to_c_string (field_scm);
|
|
|
|
|
cleanups = make_cleanup (xfree, field);
|
|
|
|
|
|
|
|
|
|
for (i = 0; i < TYPE_NFIELDS (type); i++)
|
|
|
|
|
{
|
|
|
|
|
const char *t_field_name = TYPE_FIELD_NAME (type, i);
|
|
|
|
|
|
|
|
|
|
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
|
|
|
|
|
{
|
|
|
|
|
do_cleanups (cleanups);
|
|
|
|
|
return tyscm_make_field_smob (self, i);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
do_cleanups (cleanups);
|
|
|
|
|
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm,
|
|
|
|
|
_("Unknown field"));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-has-field? <gdb:type> string) -> boolean
|
|
|
|
|
Return boolean indicating if type SELF has FIELD_SCM (a string). */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_has_field_p (SCM self, SCM field_scm)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
char *field;
|
|
|
|
|
int i;
|
|
|
|
|
struct cleanup *cleanups;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
|
|
|
|
|
_("string"));
|
|
|
|
|
|
|
|
|
|
/* We want just fields of this type, not of base types, so instead of
|
|
|
|
|
using lookup_struct_elt_type, portions of that function are
|
|
|
|
|
copied here. */
|
|
|
|
|
|
|
|
|
|
type = tyscm_get_composite (type);
|
|
|
|
|
if (type == NULL)
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
|
|
|
|
|
_(not_composite_error));
|
|
|
|
|
|
|
|
|
|
field = gdbscm_scm_to_c_string (field_scm);
|
|
|
|
|
cleanups = make_cleanup (xfree, field);
|
|
|
|
|
|
|
|
|
|
for (i = 0; i < TYPE_NFIELDS (type); i++)
|
|
|
|
|
{
|
|
|
|
|
const char *t_field_name = TYPE_FIELD_NAME (type, i);
|
|
|
|
|
|
|
|
|
|
if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
|
|
|
|
|
{
|
|
|
|
|
do_cleanups (cleanups);
|
|
|
|
|
return SCM_BOOL_T;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
do_cleanups (cleanups);
|
|
|
|
|
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (make-field-iterator <gdb:type>) -> <gdb:iterator>
|
|
|
|
|
Make a field iterator object. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_make_field_iterator (SCM self)
|
|
|
|
|
{
|
|
|
|
|
type_smob *t_smob
|
|
|
|
|
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct type *type = t_smob->type;
|
|
|
|
|
struct type *containing_type;
|
|
|
|
|
SCM containing_type_scm;
|
|
|
|
|
|
|
|
|
|
containing_type = tyscm_get_composite (type);
|
|
|
|
|
if (containing_type == NULL)
|
|
|
|
|
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
|
|
|
|
|
_(not_composite_error));
|
|
|
|
|
|
|
|
|
|
/* If SELF is a typedef or reference, we want the underlying type,
|
|
|
|
|
which is what tyscm_get_composite returns. */
|
|
|
|
|
if (containing_type == type)
|
|
|
|
|
containing_type_scm = self;
|
|
|
|
|
else
|
|
|
|
|
containing_type_scm = tyscm_scm_from_type (containing_type);
|
|
|
|
|
|
|
|
|
|
return gdbscm_make_iterator (containing_type_scm, scm_from_int (0),
|
|
|
|
|
tyscm_next_field_x_proc);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (type-next-field! <gdb:iterator>) -> <gdb:field>
|
|
|
|
|
Return the next field in the iteration through the list of fields of the
|
|
|
|
|
type, or (end-of-iteration).
|
|
|
|
|
SELF is a <gdb:iterator> object created by gdbscm_make_field_iterator.
|
|
|
|
|
This is the next! <gdb:iterator> function, not exported to the user. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_type_next_field_x (SCM self)
|
|
|
|
|
{
|
|
|
|
|
iterator_smob *i_smob;
|
|
|
|
|
type_smob *t_smob;
|
|
|
|
|
struct type *type;
|
|
|
|
|
SCM it_scm, result, progress, object;
|
|
|
|
|
int field, rc;
|
|
|
|
|
|
|
|
|
|
it_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
i_smob = (iterator_smob *) SCM_SMOB_DATA (it_scm);
|
|
|
|
|
object = itscm_iterator_smob_object (i_smob);
|
|
|
|
|
progress = itscm_iterator_smob_progress (i_smob);
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (tyscm_is_type (object), object,
|
|
|
|
|
SCM_ARG1, FUNC_NAME, type_smob_name);
|
|
|
|
|
t_smob = (type_smob *) SCM_SMOB_DATA (object);
|
|
|
|
|
type = t_smob->type;
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (scm_is_signed_integer (progress,
|
|
|
|
|
0, TYPE_NFIELDS (type)),
|
|
|
|
|
progress, SCM_ARG1, FUNC_NAME, _("integer"));
|
|
|
|
|
field = scm_to_int (progress);
|
|
|
|
|
|
|
|
|
|
if (field < TYPE_NFIELDS (type))
|
|
|
|
|
{
|
|
|
|
|
result = tyscm_make_field_smob (object, field);
|
|
|
|
|
itscm_set_iterator_smob_progress_x (i_smob, scm_from_int (field + 1));
|
|
|
|
|
return result;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return gdbscm_end_of_iteration ();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Field smob accessors. */
|
|
|
|
|
|
|
|
|
|
/* (field-name <gdb:field>) -> string
|
|
|
|
|
Return the name of this field or #f if there isn't one. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_name (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob
|
|
|
|
|
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct field *field = tyscm_field_smob_to_field (f_smob);
|
|
|
|
|
|
|
|
|
|
if (FIELD_NAME (*field))
|
|
|
|
|
return gdbscm_scm_from_c_string (FIELD_NAME (*field));
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (field-type <gdb:field>) -> <gdb:type>
|
|
|
|
|
Return the <gdb:type> object of the field or #f if there isn't one. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_type (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob
|
|
|
|
|
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct field *field = tyscm_field_smob_to_field (f_smob);
|
|
|
|
|
|
|
|
|
|
/* A field can have a NULL type in some situations. */
|
|
|
|
|
if (FIELD_TYPE (*field))
|
|
|
|
|
return tyscm_scm_from_type (FIELD_TYPE (*field));
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (field-enumval <gdb:field>) -> integer
|
|
|
|
|
For enum values, return its value as an integer. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_enumval (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob
|
|
|
|
|
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct field *field = tyscm_field_smob_to_field (f_smob);
|
|
|
|
|
struct type *type = tyscm_field_smob_containing_type (f_smob);
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (TYPE_CODE (type) == TYPE_CODE_ENUM,
|
|
|
|
|
self, SCM_ARG1, FUNC_NAME, _("enum type"));
|
|
|
|
|
|
|
|
|
|
return scm_from_long (FIELD_ENUMVAL (*field));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (field-bitpos <gdb:field>) -> integer
|
|
|
|
|
For bitfields, return its offset in bits. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_bitpos (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob
|
|
|
|
|
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct field *field = tyscm_field_smob_to_field (f_smob);
|
|
|
|
|
struct type *type = tyscm_field_smob_containing_type (f_smob);
|
|
|
|
|
|
|
|
|
|
SCM_ASSERT_TYPE (TYPE_CODE (type) != TYPE_CODE_ENUM,
|
|
|
|
|
self, SCM_ARG1, FUNC_NAME, _("non-enum type"));
|
|
|
|
|
|
|
|
|
|
return scm_from_long (FIELD_BITPOS (*field));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (field-bitsize <gdb:field>) -> integer
|
|
|
|
|
Return the size of the field in bits. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_bitsize (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob
|
|
|
|
|
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct field *field = tyscm_field_smob_to_field (f_smob);
|
|
|
|
|
|
|
|
|
|
return scm_from_long (FIELD_BITPOS (*field));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (field-artificial? <gdb:field>) -> boolean
|
|
|
|
|
Return #t if field is artificial. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_artificial_p (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob
|
|
|
|
|
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct field *field = tyscm_field_smob_to_field (f_smob);
|
|
|
|
|
|
|
|
|
|
return scm_from_bool (FIELD_ARTIFICIAL (*field));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (field-baseclass? <gdb:field>) -> boolean
|
|
|
|
|
Return #t if field is a baseclass. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_field_baseclass_p (SCM self)
|
|
|
|
|
{
|
|
|
|
|
field_smob *f_smob
|
|
|
|
|
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
|
|
|
|
struct field *field = tyscm_field_smob_to_field (f_smob);
|
|
|
|
|
struct type *type = tyscm_field_smob_containing_type (f_smob);
|
|
|
|
|
|
|
|
|
|
if (TYPE_CODE (type) == TYPE_CODE_CLASS)
|
|
|
|
|
return scm_from_bool (f_smob->field_num < TYPE_N_BASECLASSES (type));
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Return the type named TYPE_NAME in BLOCK.
|
|
|
|
|
Returns NULL if not found.
|
|
|
|
|
This routine does not throw an error. */
|
|
|
|
|
|
|
|
|
|
static struct type *
|
|
|
|
|
tyscm_lookup_typename (const char *type_name, const struct block *block)
|
|
|
|
|
{
|
|
|
|
|
struct type *type = NULL;
|
|
|
|
|
volatile struct gdb_exception except;
|
|
|
|
|
|
|
|
|
|
TRY_CATCH (except, RETURN_MASK_ALL)
|
|
|
|
|
{
|
|
|
|
|
if (!strncmp (type_name, "struct ", 7))
|
|
|
|
|
type = lookup_struct (type_name + 7, NULL);
|
|
|
|
|
else if (!strncmp (type_name, "union ", 6))
|
|
|
|
|
type = lookup_union (type_name + 6, NULL);
|
|
|
|
|
else if (!strncmp (type_name, "enum ", 5))
|
|
|
|
|
type = lookup_enum (type_name + 5, NULL);
|
|
|
|
|
else
|
|
|
|
|
type = lookup_typename (current_language, get_current_arch (),
|
|
|
|
|
type_name, block, 0);
|
|
|
|
|
}
|
|
|
|
|
if (except.reason < 0)
|
|
|
|
|
return NULL;
|
|
|
|
|
|
|
|
|
|
return type;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* (lookup-type name [#:block <gdb:block>]) -> <gdb:type>
|
|
|
|
|
TODO: legacy template support left out until needed. */
|
|
|
|
|
|
|
|
|
|
static SCM
|
|
|
|
|
gdbscm_lookup_type (SCM name_scm, SCM rest)
|
|
|
|
|
{
|
|
|
|
|
SCM keywords[] = { block_keyword, SCM_BOOL_F };
|
|
|
|
|
char *name;
|
|
|
|
|
SCM block_scm = SCM_BOOL_F;
|
|
|
|
|
int block_arg_pos = -1;
|
|
|
|
|
const struct block *block = NULL;
|
|
|
|
|
struct type *type;
|
|
|
|
|
|
|
|
|
|
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#O",
|
|
|
|
|
name_scm, &name,
|
|
|
|
|
rest, &block_arg_pos, &block_scm);
|
|
|
|
|
|
|
|
|
|
if (block_arg_pos != -1)
|
|
|
|
|
{
|
|
|
|
|
SCM exception;
|
|
|
|
|
|
|
|
|
|
block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
|
|
|
|
|
&exception);
|
|
|
|
|
if (block == NULL)
|
|
|
|
|
{
|
|
|
|
|
xfree (name);
|
|
|
|
|
gdbscm_throw (exception);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
type = tyscm_lookup_typename (name, block);
|
|
|
|
|
xfree (name);
|
|
|
|
|
|
|
|
|
|
if (type != NULL)
|
|
|
|
|
return tyscm_scm_from_type (type);
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* Initialize the Scheme type code. */
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static const scheme_integer_constant type_integer_constants[] =
|
|
|
|
|
{
|
|
|
|
|
#define X(SYM) { #SYM, SYM }
|
|
|
|
|
X (TYPE_CODE_BITSTRING),
|
|
|
|
|
X (TYPE_CODE_PTR),
|
|
|
|
|
X (TYPE_CODE_ARRAY),
|
|
|
|
|
X (TYPE_CODE_STRUCT),
|
|
|
|
|
X (TYPE_CODE_UNION),
|
|
|
|
|
X (TYPE_CODE_ENUM),
|
|
|
|
|
X (TYPE_CODE_FLAGS),
|
|
|
|
|
X (TYPE_CODE_FUNC),
|
|
|
|
|
X (TYPE_CODE_INT),
|
|
|
|
|
X (TYPE_CODE_FLT),
|
|
|
|
|
X (TYPE_CODE_VOID),
|
|
|
|
|
X (TYPE_CODE_SET),
|
|
|
|
|
X (TYPE_CODE_RANGE),
|
|
|
|
|
X (TYPE_CODE_STRING),
|
|
|
|
|
X (TYPE_CODE_ERROR),
|
|
|
|
|
X (TYPE_CODE_METHOD),
|
|
|
|
|
X (TYPE_CODE_METHODPTR),
|
|
|
|
|
X (TYPE_CODE_MEMBERPTR),
|
|
|
|
|
X (TYPE_CODE_REF),
|
|
|
|
|
X (TYPE_CODE_CHAR),
|
|
|
|
|
X (TYPE_CODE_BOOL),
|
|
|
|
|
X (TYPE_CODE_COMPLEX),
|
|
|
|
|
X (TYPE_CODE_TYPEDEF),
|
|
|
|
|
X (TYPE_CODE_NAMESPACE),
|
|
|
|
|
X (TYPE_CODE_DECFLOAT),
|
|
|
|
|
X (TYPE_CODE_INTERNAL_FUNCTION),
|
|
|
|
|
#undef X
|
|
|
|
|
|
|
|
|
|
END_INTEGER_CONSTANTS
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
static const scheme_function type_functions[] =
|
|
|
|
|
{
|
|
|
|
|
{ "type?", 1, 0, 0, gdbscm_type_p,
|
|
|
|
|
"\
|
|
|
|
|
Return #t if the object is a <gdb:type> object." },
|
|
|
|
|
|
|
|
|
|
{ "lookup-type", 1, 0, 1, gdbscm_lookup_type,
|
|
|
|
|
"\
|
|
|
|
|
Return the <gdb:type> object representing string or #f if not found.\n\
|
|
|
|
|
If block is given then the type is looked for in that block.\n\
|
|
|
|
|
\n\
|
|
|
|
|
Arguments: string [#:block <gdb:block>]" },
|
|
|
|
|
|
|
|
|
|
{ "type-code", 1, 0, 0, gdbscm_type_code,
|
|
|
|
|
"\
|
|
|
|
|
Return the code of the type" },
|
|
|
|
|
|
|
|
|
|
{ "type-tag", 1, 0, 0, gdbscm_type_tag,
|
|
|
|
|
"\
|
|
|
|
|
Return the tag name of the type, or #f if there isn't one." },
|
|
|
|
|
|
|
|
|
|
{ "type-name", 1, 0, 0, gdbscm_type_name,
|
|
|
|
|
"\
|
|
|
|
|
Return the name of the type as a string, or #f if there isn't one." },
|
|
|
|
|
|
|
|
|
|
{ "type-print-name", 1, 0, 0, gdbscm_type_print_name,
|
|
|
|
|
"\
|
|
|
|
|
Return the print name of the type as a string." },
|
|
|
|
|
|
|
|
|
|
{ "type-sizeof", 1, 0, 0, gdbscm_type_sizeof,
|
|
|
|
|
"\
|
|
|
|
|
Return the size of the type, in bytes." },
|
|
|
|
|
|
|
|
|
|
{ "type-strip-typedefs", 1, 0, 0, gdbscm_type_strip_typedefs,
|
|
|
|
|
"\
|
|
|
|
|
Return a type formed by stripping the type of all typedefs." },
|
|
|
|
|
|
|
|
|
|
{ "type-array", 2, 1, 0, gdbscm_type_array,
|
|
|
|
|
"\
|
|
|
|
|
Return a type representing an array of objects of the type.\n\
|
|
|
|
|
\n\
|
|
|
|
|
Arguments: <gdb:type> [low-bound] high-bound\n\
|
|
|
|
|
If low-bound is not provided zero is used.\n\
|
|
|
|
|
N.B. If only the high-bound parameter is specified, it is not\n\
|
|
|
|
|
the array size.\n\
|
|
|
|
|
Valid bounds for array indices are [low-bound,high-bound]." },
|
|
|
|
|
|
|
|
|
|
{ "type-vector", 2, 1, 0, gdbscm_type_vector,
|
|
|
|
|
"\
|
|
|
|
|
Return a type representing a vector of objects of the type.\n\
|
|
|
|
|
Vectors differ from arrays in that if the current language has C-style\n\
|
|
|
|
|
arrays, vectors don't decay to a pointer to the first element.\n\
|
|
|
|
|
They are first class values.\n\
|
|
|
|
|
\n\
|
|
|
|
|
Arguments: <gdb:type> [low-bound] high-bound\n\
|
|
|
|
|
If low-bound is not provided zero is used.\n\
|
|
|
|
|
N.B. If only the high-bound parameter is specified, it is not\n\
|
|
|
|
|
the array size.\n\
|
|
|
|
|
Valid bounds for array indices are [low-bound,high-bound]." },
|
|
|
|
|
|
|
|
|
|
{ "type-pointer", 1, 0, 0, gdbscm_type_pointer,
|
|
|
|
|
"\
|
|
|
|
|
Return a type of pointer to the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-range", 1, 0, 0, gdbscm_type_range,
|
|
|
|
|
"\
|
|
|
|
|
Return (low high) representing the range for the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-reference", 1, 0, 0, gdbscm_type_reference,
|
|
|
|
|
"\
|
|
|
|
|
Return a type of reference to the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-target", 1, 0, 0, gdbscm_type_target,
|
|
|
|
|
"\
|
|
|
|
|
Return the target type of the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-const", 1, 0, 0, gdbscm_type_const,
|
|
|
|
|
"\
|
|
|
|
|
Return a const variant of the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-volatile", 1, 0, 0, gdbscm_type_volatile,
|
|
|
|
|
"\
|
|
|
|
|
Return a volatile variant of the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-unqualified", 1, 0, 0, gdbscm_type_unqualified,
|
|
|
|
|
"\
|
|
|
|
|
Return a variant of the type without const or volatile attributes." },
|
|
|
|
|
|
|
|
|
|
{ "type-num-fields", 1, 0, 0, gdbscm_type_num_fields,
|
|
|
|
|
"\
|
|
|
|
|
Return the number of fields of the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-fields", 1, 0, 0, gdbscm_type_fields,
|
|
|
|
|
"\
|
|
|
|
|
Return the list of <gdb:field> objects of fields of the type." },
|
|
|
|
|
|
|
|
|
|
{ "make-field-iterator", 1, 0, 0, gdbscm_make_field_iterator,
|
|
|
|
|
"\
|
|
|
|
|
Return a <gdb:iterator> object for iterating over the fields of the type." },
|
|
|
|
|
|
|
|
|
|
{ "type-field", 2, 0, 0, gdbscm_type_field,
|
|
|
|
|
"\
|
|
|
|
|
Return the field named by string of the type.\n\
|
|
|
|
|
\n\
|
|
|
|
|
Arguments: <gdb:type> string" },
|
|
|
|
|
|
|
|
|
|
{ "type-has-field?", 2, 0, 0, gdbscm_type_has_field_p,
|
|
|
|
|
"\
|
|
|
|
|
Return #t if the type has field named string.\n\
|
|
|
|
|
\n\
|
|
|
|
|
Arguments: <gdb:type> string" },
|
|
|
|
|
|
|
|
|
|
{ "field?", 1, 0, 0, gdbscm_field_p,
|
|
|
|
|
"\
|
|
|
|
|
Return #t if the object is a <gdb:field> object." },
|
|
|
|
|
|
|
|
|
|
{ "field-name", 1, 0, 0, gdbscm_field_name,
|
|
|
|
|
"\
|
|
|
|
|
Return the name of the field." },
|
|
|
|
|
|
|
|
|
|
{ "field-type", 1, 0, 0, gdbscm_field_type,
|
|
|
|
|
"\
|
|
|
|
|
Return the type of the field." },
|
|
|
|
|
|
|
|
|
|
{ "field-enumval", 1, 0, 0, gdbscm_field_enumval,
|
|
|
|
|
"\
|
|
|
|
|
Return the enum value represented by the field." },
|
|
|
|
|
|
|
|
|
|
{ "field-bitpos", 1, 0, 0, gdbscm_field_bitpos,
|
|
|
|
|
"\
|
|
|
|
|
Return the offset in bits of the field in its containing type." },
|
|
|
|
|
|
|
|
|
|
{ "field-bitsize", 1, 0, 0, gdbscm_field_bitsize,
|
|
|
|
|
"\
|
|
|
|
|
Return the size of the field in bits." },
|
|
|
|
|
|
|
|
|
|
{ "field-artificial?", 1, 0, 0, gdbscm_field_artificial_p,
|
|
|
|
|
"\
|
|
|
|
|
Return #t if the field is artificial." },
|
|
|
|
|
|
|
|
|
|
{ "field-baseclass?", 1, 0, 0, gdbscm_field_baseclass_p,
|
|
|
|
|
"\
|
|
|
|
|
Return #t if the field is a baseclass." },
|
|
|
|
|
|
|
|
|
|
END_FUNCTIONS
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
gdbscm_initialize_types (void)
|
|
|
|
|
{
|
|
|
|
|
type_smob_tag = gdbscm_make_smob_type (type_smob_name, sizeof (type_smob));
|
|
|
|
|
scm_set_smob_mark (type_smob_tag, tyscm_mark_type_smob);
|
|
|
|
|
scm_set_smob_free (type_smob_tag, tyscm_free_type_smob);
|
|
|
|
|
scm_set_smob_print (type_smob_tag, tyscm_print_type_smob);
|
|
|
|
|
scm_set_smob_equalp (type_smob_tag, tyscm_equal_p_type_smob);
|
|
|
|
|
|
|
|
|
|
field_smob_tag = gdbscm_make_smob_type (field_smob_name,
|
|
|
|
|
sizeof (field_smob));
|
|
|
|
|
scm_set_smob_mark (field_smob_tag, tyscm_mark_field_smob);
|
|
|
|
|
scm_set_smob_print (field_smob_tag, tyscm_print_field_smob);
|
|
|
|
|
|
|
|
|
|
gdbscm_define_integer_constants (type_integer_constants, 1);
|
|
|
|
|
gdbscm_define_functions (type_functions, 1);
|
|
|
|
|
|
|
|
|
|
/* This function is "private". */
|
|
|
|
|
tyscm_next_field_x_proc
|
|
|
|
|
= scm_c_define_gsubr ("%type-next-field!", 1, 0, 0,
|
|
|
|
|
gdbscm_type_next_field_x);
|
|
|
|
|
scm_set_procedure_property_x (tyscm_next_field_x_proc,
|
|
|
|
|
gdbscm_documentation_symbol,
|
|
|
|
|
gdbscm_scm_from_c_string ("\
|
|
|
|
|
Internal function to assist the type fields iterator."));
|
|
|
|
|
|
|
|
|
|
block_keyword = scm_from_latin1_keyword ("block");
|
|
|
|
|
|
|
|
|
|
/* Register an objfile "free" callback so we can properly copy types
|
|
|
|
|
associated with the objfile when it's about to be deleted. */
|
|
|
|
|
tyscm_objfile_data_key
|
|
|
|
|
= register_objfile_data_with_cleanup (save_objfile_types, NULL);
|
|
|
|
|
|
|
|
|
|
global_types_map = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
|
|
|
|
|
tyscm_eq_type_smob);
|
|
|
|
|
}
|