diff options
author | Doug Evans <xdje42@gmail.com> | 2014-02-09 19:40:01 -0800 |
---|---|---|
committer | Doug Evans <xdje42@gmail.com> | 2014-02-09 19:40:01 -0800 |
commit | ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461 (patch) | |
tree | 4e67d95b8ea65bb36a9cade5e37df2ad6289052e /gdb/guile/scm-symbol.c | |
parent | 7026a7c16ee82d39e84823f8cc3097a9a940ddb2 (diff) | |
download | gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.zip gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.tar.gz gdb-ed3ef33944c39d9a3cea72b9a7cef3c20f0e3461.tar.bz2 |
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.
Diffstat (limited to 'gdb/guile/scm-symbol.c')
-rw-r--r-- | gdb/guile/scm-symbol.c | 777 |
1 files changed, 777 insertions, 0 deletions
diff --git a/gdb/guile/scm-symbol.c b/gdb/guile/scm-symbol.c new file mode 100644 index 0000000..53cc272 --- /dev/null +++ b/gdb/guile/scm-symbol.c @@ -0,0 +1,777 @@ +/* Scheme interface to symbols. + + 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 "block.h" +#include "exceptions.h" +#include "frame.h" +#include "symtab.h" +#include "objfiles.h" +#include "value.h" +#include "guile-internal.h" + +/* The <gdb:symbol> smob. */ + +typedef struct +{ + /* This always appears first. */ + eqable_gdb_smob base; + + /* The GDB symbol structure this smob is wrapping. */ + struct symbol *symbol; +} symbol_smob; + +static const char symbol_smob_name[] = "gdb:symbol"; + +/* The tag Guile knows the symbol smob by. */ +static scm_t_bits symbol_smob_tag; + +/* Keywords used in argument passing. */ +static SCM block_keyword; +static SCM domain_keyword; +static SCM frame_keyword; + +static const struct objfile_data *syscm_objfile_data_key; + +/* Administrivia for symbol smobs. */ + +/* Helper function to hash a symbol_smob. */ + +static hashval_t +syscm_hash_symbol_smob (const void *p) +{ + const symbol_smob *s_smob = p; + + return htab_hash_pointer (s_smob->symbol); +} + +/* Helper function to compute equality of symbol_smobs. */ + +static int +syscm_eq_symbol_smob (const void *ap, const void *bp) +{ + const symbol_smob *a = ap; + const symbol_smob *b = bp; + + return (a->symbol == b->symbol + && a->symbol != NULL); +} + +/* Return the struct symbol pointer -> SCM mapping table. + It is created if necessary. */ + +static htab_t +syscm_objfile_symbol_map (struct symbol *symbol) +{ + struct objfile *objfile = SYMBOL_SYMTAB (symbol)->objfile; + htab_t htab = objfile_data (objfile, syscm_objfile_data_key); + + if (htab == NULL) + { + htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob, + syscm_eq_symbol_smob); + set_objfile_data (objfile, syscm_objfile_data_key, htab); + } + + return htab; +} + +/* The smob "mark" function for <gdb:symbol>. */ + +static SCM +syscm_mark_symbol_smob (SCM self) +{ + symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self); + + /* Do this last. */ + return gdbscm_mark_eqable_gsmob (&s_smob->base); +} + +/* The smob "free" function for <gdb:symbol>. */ + +static size_t +syscm_free_symbol_smob (SCM self) +{ + symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self); + + if (s_smob->symbol != NULL) + { + htab_t htab = syscm_objfile_symbol_map (s_smob->symbol); + + gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base); + } + + /* Not necessary, done to catch bugs. */ + s_smob->symbol = NULL; + + return 0; +} + +/* The smob "print" function for <gdb:symbol>. */ + +static int +syscm_print_symbol_smob (SCM self, SCM port, scm_print_state *pstate) +{ + symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self); + + if (pstate->writingp) + gdbscm_printf (port, "#<%s ", symbol_smob_name); + gdbscm_printf (port, "%s", + s_smob->symbol != NULL + ? SYMBOL_PRINT_NAME (s_smob->symbol) + : "<invalid>"); + if (pstate->writingp) + scm_puts (">", port); + + scm_remember_upto_here_1 (self); + + /* Non-zero means success. */ + return 1; +} + +/* Low level routine to create a <gdb:symbol> object. */ + +static SCM +syscm_make_symbol_smob (void) +{ + symbol_smob *s_smob = (symbol_smob *) + scm_gc_malloc (sizeof (symbol_smob), symbol_smob_name); + SCM s_scm; + + s_smob->symbol = NULL; + s_scm = scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob); + gdbscm_init_eqable_gsmob (&s_smob->base); + + return s_scm; +} + +/* Return non-zero if SCM is a symbol smob. */ + +int +syscm_is_symbol (SCM scm) +{ + return SCM_SMOB_PREDICATE (symbol_smob_tag, scm); +} + +/* (symbol? object) -> boolean */ + +static SCM +gdbscm_symbol_p (SCM scm) +{ + return scm_from_bool (syscm_is_symbol (scm)); +} + +/* Return the existing object that encapsulates SYMBOL, or create a new + <gdb:symbol> object. */ + +SCM +syscm_scm_from_symbol (struct symbol *symbol) +{ + htab_t htab; + eqable_gdb_smob **slot; + symbol_smob *s_smob, s_smob_for_lookup; + SCM s_scm; + + /* If we've already created a gsmob for this symbol, return it. + This makes symbols eq?-able. */ + htab = syscm_objfile_symbol_map (symbol); + s_smob_for_lookup.symbol = symbol; + slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &s_smob_for_lookup.base); + if (*slot != NULL) + return (*slot)->containing_scm; + + s_scm = syscm_make_symbol_smob (); + s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm); + s_smob->symbol = symbol; + gdbscm_fill_eqable_gsmob_ptr_slot (slot, &s_smob->base, s_scm); + + return s_scm; +} + +/* Returns the <gdb:symbol> object in SELF. + Throws an exception if SELF is not a <gdb:symbol> object. */ + +static SCM +syscm_get_symbol_arg_unsafe (SCM self, int arg_pos, const char *func_name) +{ + SCM_ASSERT_TYPE (syscm_is_symbol (self), self, arg_pos, func_name, + symbol_smob_name); + + return self; +} + +/* Returns a pointer to the symbol smob of SELF. + Throws an exception if SELF is not a <gdb:symbol> object. */ + +static symbol_smob * +syscm_get_symbol_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) +{ + SCM s_scm = syscm_get_symbol_arg_unsafe (self, arg_pos, func_name); + symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm); + + return s_smob; +} + +/* Return non-zero if symbol S_SMOB is valid. */ + +static int +syscm_is_valid (symbol_smob *s_smob) +{ + return s_smob->symbol != NULL; +} + +/* Throw a Scheme error if SELF is not a valid symbol smob. + Otherwise return a pointer to the symbol smob. */ + +static symbol_smob * +syscm_get_valid_symbol_smob_arg_unsafe (SCM self, int arg_pos, + const char *func_name) +{ + symbol_smob *s_smob + = syscm_get_symbol_smob_arg_unsafe (self, arg_pos, func_name); + + if (!syscm_is_valid (s_smob)) + { + gdbscm_invalid_object_error (func_name, arg_pos, self, + _("<gdb:symbol>")); + } + + return s_smob; +} + +/* Throw a Scheme error if SELF is not a valid symbol smob. + Otherwise return a pointer to the symbol struct. */ + +struct symbol * +syscm_get_valid_symbol_arg_unsafe (SCM self, int arg_pos, + const char *func_name) +{ + symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, arg_pos, + func_name); + + return s_smob->symbol; +} + +/* Helper function for syscm_del_objfile_symbols to mark the symbol + as invalid. */ + +static int +syscm_mark_symbol_invalid (void **slot, void *info) +{ + symbol_smob *s_smob = (symbol_smob *) *slot; + + s_smob->symbol = NULL; + return 1; +} + +/* This function is called when an objfile is about to be freed. + Invalidate the symbol as further actions on the symbol would result + in bad data. All access to s_smob->symbol should be gated by + syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on + invalid symbols. */ + +static void +syscm_del_objfile_symbols (struct objfile *objfile, void *datum) +{ + htab_t htab = datum; + + if (htab != NULL) + { + htab_traverse_noresize (htab, syscm_mark_symbol_invalid, NULL); + htab_delete (htab); + } +} + +/* Symbol methods. */ + +/* (symbol-valid? <gdb:symbol>) -> boolean + Returns #t if SELF still exists in GDB. */ + +static SCM +gdbscm_symbol_valid_p (SCM self) +{ + symbol_smob *s_smob + = syscm_get_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + + return scm_from_bool (syscm_is_valid (s_smob)); +} + +/* (symbol-type <gdb:symbol>) -> <gdb:type> + Return the type of SELF, or #f if SELF has no type. */ + +static SCM +gdbscm_symbol_type (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + if (SYMBOL_TYPE (symbol) == NULL) + return SCM_BOOL_F; + + return tyscm_scm_from_type (SYMBOL_TYPE (symbol)); +} + +/* (symbol-symtab <gdb:symbol>) -> <gdb:symtab> + Return the symbol table of SELF. */ + +static SCM +gdbscm_symbol_symtab (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + return stscm_scm_from_symtab (SYMBOL_SYMTAB (symbol)); +} + +/* (symbol-name <gdb:symbol>) -> string */ + +static SCM +gdbscm_symbol_name (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol)); +} + +/* (symbol-linkage-name <gdb:symbol>) -> string */ + +static SCM +gdbscm_symbol_linkage_name (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol)); +} + +/* (symbol-print-name <gdb:symbol>) -> string */ + +static SCM +gdbscm_symbol_print_name (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol)); +} + +/* (symbol-addr-class <gdb:symbol>) -> integer */ + +static SCM +gdbscm_symbol_addr_class (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + return scm_from_int (SYMBOL_CLASS (symbol)); +} + +/* (symbol-argument? <gdb:symbol>) -> boolean */ + +static SCM +gdbscm_symbol_argument_p (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol)); +} + +/* (symbol-constant? <gdb:symbol>) -> boolean */ + +static SCM +gdbscm_symbol_constant_p (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + enum address_class class; + + class = SYMBOL_CLASS (symbol); + + return scm_from_bool (class == LOC_CONST || class == LOC_CONST_BYTES); +} + +/* (symbol-function? <gdb:symbol>) -> boolean */ + +static SCM +gdbscm_symbol_function_p (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + enum address_class class; + + class = SYMBOL_CLASS (symbol); + + return scm_from_bool (class == LOC_BLOCK); +} + +/* (symbol-variable? <gdb:symbol>) -> boolean */ + +static SCM +gdbscm_symbol_variable_p (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + enum address_class class; + + class = SYMBOL_CLASS (symbol); + + return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol) + && (class == LOC_LOCAL || class == LOC_REGISTER + || class == LOC_STATIC || class == LOC_COMPUTED + || class == LOC_OPTIMIZED_OUT)); +} + +/* (symbol-needs-frame? <gdb:symbol>) -> boolean + Return #t if the symbol needs a frame for evaluation. */ + +static SCM +gdbscm_symbol_needs_frame_p (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + struct symbol *symbol = s_smob->symbol; + volatile struct gdb_exception except; + int result = 0; + + TRY_CATCH (except, RETURN_MASK_ALL) + { + result = symbol_read_needs_frame (symbol); + } + GDBSCM_HANDLE_GDB_EXCEPTION (except); + + return scm_from_bool (result); +} + +/* (symbol-line <gdb:symbol>) -> integer + Return the line number at which the symbol was defined. */ + +static SCM +gdbscm_symbol_line (SCM self) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct symbol *symbol = s_smob->symbol; + + return scm_from_int (SYMBOL_LINE (symbol)); +} + +/* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value> + Return the value of the symbol, or an error in various circumstances. */ + +static SCM +gdbscm_symbol_value (SCM self, SCM rest) +{ + symbol_smob *s_smob + = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + struct symbol *symbol = s_smob->symbol; + SCM keywords[] = { frame_keyword, SCM_BOOL_F }; + int frame_pos = -1; + SCM frame_scm = SCM_BOOL_F; + frame_smob *f_smob = NULL; + struct frame_info *frame_info = NULL; + struct value *value = NULL; + volatile struct gdb_exception except; + + gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", + rest, &frame_pos, &frame_scm); + if (!gdbscm_is_false (frame_scm)) + f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME); + + if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF) + { + gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, + _("cannot get the value of a typedef")); + } + + TRY_CATCH (except, RETURN_MASK_ALL) + { + if (f_smob != NULL) + { + frame_info = frscm_frame_smob_to_frame (f_smob); + if (frame_info == NULL) + error (_("Invalid frame")); + } + + if (symbol_read_needs_frame (symbol) && frame_info == NULL) + error (_("Symbol requires a frame to compute its value")); + + value = read_var_value (symbol, frame_info); + } + GDBSCM_HANDLE_GDB_EXCEPTION (except); + + return vlscm_scm_from_value (value); +} + +/* (lookup-symbol name [#:block <gdb:block>] [#:domain domain]) + -> (<gdb:symbol> field-of-this?) + The result is #f if the symbol is not found. + See comment in lookup_symbol_in_language for field-of-this?. */ + +static SCM +gdbscm_lookup_symbol (SCM name_scm, SCM rest) +{ + char *name; + SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F }; + const struct block *block = NULL; + SCM block_scm = SCM_BOOL_F; + int domain = VAR_DOMAIN; + int block_arg_pos = -1, domain_arg_pos = -1; + struct field_of_this_result is_a_field_of_this; + struct symbol *symbol = NULL; + volatile struct gdb_exception except; + struct cleanup *cleanups; + + gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi", + name_scm, &name, rest, + &block_arg_pos, &block_scm, + &domain_arg_pos, &domain); + + cleanups = make_cleanup (xfree, name); + + if (block_arg_pos >= 0) + { + SCM except_scm; + + block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME, + &except_scm); + if (block == NULL) + { + do_cleanups (cleanups); + gdbscm_throw (except_scm); + } + } + else + { + struct frame_info *selected_frame; + + TRY_CATCH (except, RETURN_MASK_ALL) + { + selected_frame = get_selected_frame (_("no frame selected")); + block = get_frame_block (selected_frame, NULL); + } + GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups); + } + + TRY_CATCH (except, RETURN_MASK_ALL) + { + symbol = lookup_symbol (name, block, domain, &is_a_field_of_this); + } + do_cleanups (cleanups); + GDBSCM_HANDLE_GDB_EXCEPTION (except); + + if (symbol == NULL) + return SCM_BOOL_F; + + return scm_list_2 (syscm_scm_from_symbol (symbol), + scm_from_bool (is_a_field_of_this.type != NULL)); +} + +/* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol> + The result is #f if the symbol is not found. */ + +static SCM +gdbscm_lookup_global_symbol (SCM name_scm, SCM rest) +{ + char *name; + SCM keywords[] = { domain_keyword, SCM_BOOL_F }; + int domain_arg_pos = -1; + int domain = VAR_DOMAIN; + struct symbol *symbol = NULL; + volatile struct gdb_exception except; + struct cleanup *cleanups; + + gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i", + name_scm, &name, rest, + &domain_arg_pos, &domain); + + cleanups = make_cleanup (xfree, name); + + TRY_CATCH (except, RETURN_MASK_ALL) + { + symbol = lookup_symbol_global (name, NULL, domain); + } + do_cleanups (cleanups); + GDBSCM_HANDLE_GDB_EXCEPTION (except); + + if (symbol == NULL) + return SCM_BOOL_F; + + return syscm_scm_from_symbol (symbol); +} + +/* Initialize the Scheme symbol support. */ + +/* Note: The SYMBOL_ prefix on the integer constants here is present for + compatibility with the Python support. */ + +static const scheme_integer_constant symbol_integer_constants[] = +{ +#define X(SYM) { "SYMBOL_" #SYM, SYM } + X (LOC_UNDEF), + X (LOC_CONST), + X (LOC_STATIC), + X (LOC_REGISTER), + X (LOC_ARG), + X (LOC_REF_ARG), + X (LOC_LOCAL), + X (LOC_TYPEDEF), + X (LOC_LABEL), + X (LOC_BLOCK), + X (LOC_CONST_BYTES), + X (LOC_UNRESOLVED), + X (LOC_OPTIMIZED_OUT), + X (LOC_COMPUTED), + X (LOC_REGPARM_ADDR), + + X (UNDEF_DOMAIN), + X (VAR_DOMAIN), + X (STRUCT_DOMAIN), + X (LABEL_DOMAIN), + X (VARIABLES_DOMAIN), + X (FUNCTIONS_DOMAIN), + X (TYPES_DOMAIN), +#undef X + + END_INTEGER_CONSTANTS +}; + +static const scheme_function symbol_functions[] = +{ + { "symbol?", 1, 0, 0, gdbscm_symbol_p, + "\ +Return #t if the object is a <gdb:symbol> object." }, + + { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p, + "\ +Return #t if object is a valid <gdb:symbol> object.\n\ +A valid symbol is a symbol that has not been freed.\n\ +Symbols are freed when the objfile they come from is freed." }, + + { "symbol-type", 1, 0, 0, gdbscm_symbol_type, + "\ +Return the type of symbol." }, + + { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab, + "\ +Return the symbol table (<gdb:symtab>) containing symbol." }, + + { "symbol-line", 1, 0, 0, gdbscm_symbol_line, + "\ +Return the line number at which the symbol was defined." }, + + { "symbol-name", 1, 0, 0, gdbscm_symbol_name, + "\ +Return the name of the symbol as a string." }, + + { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name, + "\ +Return the linkage name of the symbol as a string." }, + + { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name, + "\ +Return the print name of the symbol as a string.\n\ +This is either name or linkage-name, depending on whether the user\n\ +asked GDB to display demangled or mangled names." }, + + { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class, + "\ +Return the address class of the symbol." }, + + { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p, + "\ +Return #t if the symbol needs a frame to compute its value." }, + + { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p, + "\ +Return #t if the symbol is a function argument." }, + + { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p, + "\ +Return #t if the symbol is a constant." }, + + { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p, + "\ +Return #t if the symbol is a function." }, + + { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p, + "\ +Return #t if the symbol is a variable." }, + + { "symbol-value", 1, 0, 1, gdbscm_symbol_value, + "\ +Return the value of the symbol.\n\ +\n\ + Arguments: <gdb:symbol> [#:frame frame]" }, + + { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol, + "\ +Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\ +\n\ + Arguments: name [#:block block] [#:domain domain]\n\ + name: a string containing the name of the symbol to lookup\n\ + block: a <gdb:block> object\n\ + domain: a SYMBOL_*_DOMAIN value" }, + + { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol, + "\ +Return <gdb:symbol> if found, otherwise #f.\n\ +\n\ + Arguments: name [#:domain domain]\n\ + name: a string containing the name of the symbol to lookup\n\ + domain: a SYMBOL_*_DOMAIN value" }, + + END_FUNCTIONS +}; + +void +gdbscm_initialize_symbols (void) +{ + symbol_smob_tag + = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob)); + scm_set_smob_mark (symbol_smob_tag, syscm_mark_symbol_smob); + scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob); + scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob); + + gdbscm_define_integer_constants (symbol_integer_constants, 1); + gdbscm_define_functions (symbol_functions, 1); + + block_keyword = scm_from_latin1_keyword ("block"); + domain_keyword = scm_from_latin1_keyword ("domain"); + frame_keyword = scm_from_latin1_keyword ("frame"); + + /* Register an objfile "free" callback so we can properly + invalidate symbols when an object file is about to be deleted. */ + syscm_objfile_data_key + = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols); +} |