diff options
Diffstat (limited to 'gdb/guile/scm-block.c')
| -rw-r--r-- | gdb/guile/scm-block.c | 828 |
1 files changed, 828 insertions, 0 deletions
diff --git a/gdb/guile/scm-block.c b/gdb/guile/scm-block.c new file mode 100644 index 0000000..de41af2 --- /dev/null +++ b/gdb/guile/scm-block.c @@ -0,0 +1,828 @@ +/* Scheme interface to blocks. + + 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 "dictionary.h" +#include "objfiles.h" +#include "source.h" +#include "symtab.h" +#include "guile-internal.h" + +/* A smob describing a gdb block. */ + +typedef struct _block_smob +{ + /* This always appears first. + We want blocks to be eq?-able. And we need to be able to invalidate + blocks when the associated objfile is deleted. */ + eqable_gdb_smob base; + + /* The GDB block structure that represents a frame's code block. */ + const struct block *block; + + /* The backing object file. There is no direct relationship in GDB + between a block and an object file. When a block is created also + store a pointer to the object file for later use. */ + struct objfile *objfile; +} block_smob; + +/* To iterate over block symbols from Scheme we need to store + struct block_iterator somewhere. This is stored in the "progress" field + of <gdb:iterator>. We store the block object in iterator_smob.object, + so we don't store it here. + + Remember: While iterating over block symbols, you must continually check + whether the block is still valid. */ + +typedef struct +{ + /* This always appears first. */ + gdb_smob base; + + /* The iterator for that block. */ + struct block_iterator iter; + + /* Has the iterator been initialized flag. */ + int initialized_p; +} block_syms_progress_smob; + +static const char block_smob_name[] = "gdb:block"; +static const char block_syms_progress_smob_name[] = "gdb:block-symbols-iterator"; + +/* The tag Guile knows the block smobs by. */ +static scm_t_bits block_smob_tag; +static scm_t_bits block_syms_progress_smob_tag; + +/* The "next!" block syms iterator method. */ +static SCM bkscm_next_symbol_x_proc; + +static const struct objfile_data *bkscm_objfile_data_key; + +/* Administrivia for block smobs. */ + +/* Helper function to hash a block_smob. */ + +static hashval_t +bkscm_hash_block_smob (const void *p) +{ + const block_smob *b_smob = p; + + return htab_hash_pointer (b_smob->block); +} + +/* Helper function to compute equality of block_smobs. */ + +static int +bkscm_eq_block_smob (const void *ap, const void *bp) +{ + const block_smob *a = ap; + const block_smob *b = bp; + + return (a->block == b->block + && a->block != NULL); +} + +/* Return the struct block pointer -> SCM mapping table. + It is created if necessary. */ + +static htab_t +bkscm_objfile_block_map (struct objfile *objfile) +{ + htab_t htab = objfile_data (objfile, bkscm_objfile_data_key); + + if (htab == NULL) + { + htab = gdbscm_create_eqable_gsmob_ptr_map (bkscm_hash_block_smob, + bkscm_eq_block_smob); + set_objfile_data (objfile, bkscm_objfile_data_key, htab); + } + + return htab; +} + +/* The smob "mark" function for <gdb:block>. */ + +static SCM +bkscm_mark_block_smob (SCM self) +{ + block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (self); + + /* Do this last. */ + return gdbscm_mark_eqable_gsmob (&b_smob->base); +} + +/* The smob "free" function for <gdb:block>. */ + +static size_t +bkscm_free_block_smob (SCM self) +{ + block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (self); + + if (b_smob->block != NULL) + { + htab_t htab = bkscm_objfile_block_map (b_smob->objfile); + + gdbscm_clear_eqable_gsmob_ptr_slot (htab, &b_smob->base); + } + + /* Not necessary, done to catch bugs. */ + b_smob->block = NULL; + b_smob->objfile = NULL; + + return 0; +} + +/* The smob "print" function for <gdb:block>. */ + +static int +bkscm_print_block_smob (SCM self, SCM port, scm_print_state *pstate) +{ + block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (self); + const struct block *b = b_smob->block; + + gdbscm_printf (port, "#<%s", block_smob_name); + + if (BLOCK_SUPERBLOCK (b) == NULL) + gdbscm_printf (port, " global"); + else if (BLOCK_SUPERBLOCK (BLOCK_SUPERBLOCK (b)) == NULL) + gdbscm_printf (port, " static"); + + if (BLOCK_FUNCTION (b) != NULL) + gdbscm_printf (port, " %s", SYMBOL_PRINT_NAME (BLOCK_FUNCTION (b))); + + gdbscm_printf (port, " %s-%s", + hex_string (BLOCK_START (b)), hex_string (BLOCK_END (b))); + + scm_puts (">", port); + + scm_remember_upto_here_1 (self); + + /* Non-zero means success. */ + return 1; +} + +/* Low level routine to create a <gdb:block> object. */ + +static SCM +bkscm_make_block_smob (void) +{ + block_smob *b_smob = (block_smob *) + scm_gc_malloc (sizeof (block_smob), block_smob_name); + SCM b_scm; + + b_smob->block = NULL; + b_smob->objfile = NULL; + b_scm = scm_new_smob (block_smob_tag, (scm_t_bits) b_smob); + gdbscm_init_eqable_gsmob (&b_smob->base); + + return b_scm; +} + +/* Returns non-zero if SCM is a <gdb:block> object. */ + +static int +bkscm_is_block (SCM scm) +{ + return SCM_SMOB_PREDICATE (block_smob_tag, scm); +} + +/* (block? scm) -> boolean */ + +static SCM +gdbscm_block_p (SCM scm) +{ + return scm_from_bool (bkscm_is_block (scm)); +} + +/* Return the existing object that encapsulates BLOCK, or create a new + <gdb:block> object. */ + +SCM +bkscm_scm_from_block (const struct block *block, struct objfile *objfile) +{ + htab_t htab; + eqable_gdb_smob **slot; + block_smob *b_smob, b_smob_for_lookup; + SCM b_scm; + + /* If we've already created a gsmob for this block, return it. + This makes blocks eq?-able. */ + htab = bkscm_objfile_block_map (objfile); + b_smob_for_lookup.block = block; + slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &b_smob_for_lookup.base); + if (*slot != NULL) + return (*slot)->containing_scm; + + b_scm = bkscm_make_block_smob (); + b_smob = (block_smob *) SCM_SMOB_DATA (b_scm); + b_smob->block = block; + b_smob->objfile = objfile; + gdbscm_fill_eqable_gsmob_ptr_slot (slot, &b_smob->base, b_scm); + + return b_scm; +} + +/* Returns the <gdb:block> object in SELF. + Throws an exception if SELF is not a <gdb:block> object. */ + +static SCM +bkscm_get_block_arg_unsafe (SCM self, int arg_pos, const char *func_name) +{ + SCM_ASSERT_TYPE (bkscm_is_block (self), self, arg_pos, func_name, + block_smob_name); + + return self; +} + +/* Returns a pointer to the block smob of SELF. + Throws an exception if SELF is not a <gdb:block> object. */ + +static block_smob * +bkscm_get_block_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) +{ + SCM b_scm = bkscm_get_block_arg_unsafe (self, arg_pos, func_name); + block_smob *b_smob = (block_smob *) SCM_SMOB_DATA (b_scm); + + return b_smob; +} + +/* Returns non-zero if block B_SMOB is valid. */ + +static int +bkscm_is_valid (block_smob *b_smob) +{ + return b_smob->block != NULL; +} + +/* Returns the block smob in SELF, verifying it's valid. + Throws an exception if SELF is not a <gdb:block> object or is invalid. */ + +static block_smob * +bkscm_get_valid_block_smob_arg_unsafe (SCM self, int arg_pos, + const char *func_name) +{ + block_smob *b_smob + = bkscm_get_block_smob_arg_unsafe (self, arg_pos, func_name); + + if (!bkscm_is_valid (b_smob)) + { + gdbscm_invalid_object_error (func_name, arg_pos, self, + _("<gdb:block>")); + } + + return b_smob; +} + +/* Returns the block smob contained in SCM or NULL if SCM is not a + <gdb:block> object. + If there is an error a <gdb:exception> object is stored in *EXCP. */ + +static block_smob * +bkscm_get_valid_block (SCM scm, int arg_pos, const char *func_name, SCM *excp) +{ + block_smob *b_smob; + + if (!bkscm_is_block (scm)) + { + *excp = gdbscm_make_type_error (func_name, arg_pos, scm, + block_smob_name); + return NULL; + } + + b_smob = (block_smob *) SCM_SMOB_DATA (scm); + if (!bkscm_is_valid (b_smob)) + { + *excp = gdbscm_make_invalid_object_error (func_name, arg_pos, scm, + _("<gdb:block>")); + return NULL; + } + + return b_smob; +} + +/* Returns the struct block that is wrapped by BLOCK_SCM. + If BLOCK_SCM is not a block, or is an invalid block, then NULL is returned + and a <gdb:exception> object is stored in *EXCP. */ + +const struct block * +bkscm_scm_to_block (SCM block_scm, int arg_pos, const char *func_name, + SCM *excp) +{ + block_smob *b_smob; + + b_smob = bkscm_get_valid_block (block_scm, arg_pos, func_name, excp); + + if (b_smob != NULL) + return b_smob->block; + return NULL; +} + +/* Helper function for bkscm_del_objfile_blocks to mark the block + as invalid. */ + +static int +bkscm_mark_block_invalid (void **slot, void *info) +{ + block_smob *b_smob = (block_smob *) *slot; + + b_smob->block = NULL; + b_smob->objfile = NULL; + return 1; +} + +/* This function is called when an objfile is about to be freed. + Invalidate the block as further actions on the block would result + in bad data. All access to b_smob->block should be gated by + checks to ensure the block is (still) valid. */ + +static void +bkscm_del_objfile_blocks (struct objfile *objfile, void *datum) +{ + htab_t htab = datum; + + if (htab != NULL) + { + htab_traverse_noresize (htab, bkscm_mark_block_invalid, NULL); + htab_delete (htab); + } +} + +/* Block methods. */ + +/* (block-valid? <gdb:block>) -> boolean + Returns #t if SELF still exists in GDB. */ + +static SCM +gdbscm_block_valid_p (SCM self) +{ + block_smob *b_smob + = bkscm_get_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + + return scm_from_bool (bkscm_is_valid (b_smob)); +} + +/* (block-start <gdb:block>) -> address */ + +static SCM +gdbscm_block_start (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + + return gdbscm_scm_from_ulongest (BLOCK_START (block)); +} + +/* (block-end <gdb:block>) -> address */ + +static SCM +gdbscm_block_end (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + + return gdbscm_scm_from_ulongest (BLOCK_END (block)); +} + +/* (block-function <gdb:block>) -> <gdb:symbol> */ + +static SCM +gdbscm_block_function (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + struct symbol *sym; + + sym = BLOCK_FUNCTION (block); + + if (sym != NULL) + return syscm_scm_from_symbol (sym); + return SCM_BOOL_F; +} + +/* (block-superblock <gdb:block>) -> <gdb:block> */ + +static SCM +gdbscm_block_superblock (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + const struct block *super_block; + + super_block = BLOCK_SUPERBLOCK (block); + + if (super_block) + return bkscm_scm_from_block (super_block, b_smob->objfile); + return SCM_BOOL_F; +} + +/* (block-global-block <gdb:block>) -> <gdb:block> + Returns the global block associated to this block. */ + +static SCM +gdbscm_block_global_block (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + const struct block *global_block; + + global_block = block_global_block (block); + + return bkscm_scm_from_block (global_block, b_smob->objfile); +} + +/* (block-static-block <gdb:block>) -> <gdb:block> + Returns the static block associated to this block. + Returns #f if we cannot get the static block (this is the global block). */ + +static SCM +gdbscm_block_static_block (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + const struct block *static_block; + + if (BLOCK_SUPERBLOCK (block) == NULL) + return SCM_BOOL_F; + + static_block = block_static_block (block); + + return bkscm_scm_from_block (static_block, b_smob->objfile); +} + +/* (block-global? <gdb:block>) -> boolean + Returns #t if this block object is a global block. */ + +static SCM +gdbscm_block_global_p (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + + return scm_from_bool (BLOCK_SUPERBLOCK (block) == NULL); +} + +/* (block-static? <gdb:block>) -> boolean + Returns #t if this block object is a static block. */ + +static SCM +gdbscm_block_static_p (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + + if (BLOCK_SUPERBLOCK (block) != NULL + && BLOCK_SUPERBLOCK (BLOCK_SUPERBLOCK (block)) == NULL) + return SCM_BOOL_T; + return SCM_BOOL_F; +} + +/* (block-symbols <gdb:block>) -> list of <gdb:symbol objects + Returns a list of symbols of the block. */ + +static SCM +gdbscm_block_symbols (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + struct block_iterator iter; + struct symbol *sym; + SCM result; + + result = SCM_EOL; + + sym = block_iterator_first (block, &iter); + + while (sym != NULL) + { + SCM s_scm = syscm_scm_from_symbol (sym); + + result = scm_cons (s_scm, result); + sym = block_iterator_next (&iter); + } + + return scm_reverse_x (result, SCM_EOL); +} + +/* The <gdb:block-symbols-iterator> object, + for iterating over all symbols in a block. */ + +/* The smob "mark" function for <gdb:block-symbols-iterator>. */ + +static SCM +bkscm_mark_block_syms_progress_smob (SCM self) +{ + block_syms_progress_smob *i_smob + = (block_syms_progress_smob *) SCM_SMOB_DATA (self); + + /* Do this last. */ + return gdbscm_mark_gsmob (&i_smob->base); +} + +/* The smob "print" function for <gdb:block-symbols-iterator>. */ + +static int +bkscm_print_block_syms_progress_smob (SCM self, SCM port, + scm_print_state *pstate) +{ + block_syms_progress_smob *i_smob + = (block_syms_progress_smob *) SCM_SMOB_DATA (self); + + gdbscm_printf (port, "#<%s", block_syms_progress_smob_name); + + if (i_smob->initialized_p) + { + switch (i_smob->iter.which) + { + case GLOBAL_BLOCK: + case STATIC_BLOCK: + { + struct symtab *s; + + gdbscm_printf (port, " %s", + i_smob->iter.which == GLOBAL_BLOCK + ? "global" : "static"); + if (i_smob->iter.idx != -1) + gdbscm_printf (port, " @%d", i_smob->iter.idx); + s = (i_smob->iter.idx == -1 + ? i_smob->iter.d.symtab + : i_smob->iter.d.symtab->includes[i_smob->iter.idx]); + gdbscm_printf (port, " %s", symtab_to_filename_for_display (s)); + break; + } + case FIRST_LOCAL_BLOCK: + gdbscm_printf (port, " single block"); + break; + } + } + else + gdbscm_printf (port, " !initialized"); + + scm_puts (">", port); + + scm_remember_upto_here_1 (self); + + /* Non-zero means success. */ + return 1; +} + +/* Low level routine to create a <gdb:block-symbols-progress> object. */ + +static SCM +bkscm_make_block_syms_progress_smob (void) +{ + block_syms_progress_smob *i_smob = (block_syms_progress_smob *) + scm_gc_malloc (sizeof (block_syms_progress_smob), + block_syms_progress_smob_name); + SCM smob; + + memset (&i_smob->iter, 0, sizeof (i_smob->iter)); + i_smob->initialized_p = 0; + smob = scm_new_smob (block_syms_progress_smob_tag, (scm_t_bits) i_smob); + gdbscm_init_gsmob (&i_smob->base); + + return smob; +} + +/* Returns non-zero if SCM is a <gdb:block-symbols-progress> object. */ + +static int +bkscm_is_block_syms_progress (SCM scm) +{ + return SCM_SMOB_PREDICATE (block_syms_progress_smob_tag, scm); +} + +/* (block-symbols-progress? scm) -> boolean */ + +static SCM +bkscm_block_syms_progress_p (SCM scm) +{ + return scm_from_bool (bkscm_is_block_syms_progress (scm)); +} + +/* (make-block-symbols-iterator <gdb:block>) -> <gdb:iterator> + Return a <gdb:iterator> object for iterating over the symbols of SELF. */ + +static SCM +gdbscm_make_block_syms_iter (SCM self) +{ + block_smob *b_smob + = bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + const struct block *block = b_smob->block; + SCM progress, iter; + + progress = bkscm_make_block_syms_progress_smob (); + + iter = gdbscm_make_iterator (self, progress, bkscm_next_symbol_x_proc); + + return iter; +} + +/* Returns the next symbol in the iteration through the block's dictionary, + or (end-of-iteration). + This is the iterator_smob.next_x method. */ + +static SCM +gdbscm_block_next_symbol_x (SCM self) +{ + SCM progress, iter_scm, block_scm; + iterator_smob *iter_smob; + block_smob *b_smob; + const struct block *block; + block_syms_progress_smob *p_smob; + struct symbol *sym; + + iter_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME); + iter_smob = (iterator_smob *) SCM_SMOB_DATA (iter_scm); + + block_scm = itscm_iterator_smob_object (iter_smob); + b_smob = bkscm_get_valid_block_smob_arg_unsafe (block_scm, + SCM_ARG1, FUNC_NAME); + block = b_smob->block; + + progress = itscm_iterator_smob_progress (iter_smob); + + SCM_ASSERT_TYPE (bkscm_is_block_syms_progress (progress), + progress, SCM_ARG1, FUNC_NAME, + block_syms_progress_smob_name); + p_smob = (block_syms_progress_smob *) SCM_SMOB_DATA (progress); + + if (!p_smob->initialized_p) + { + sym = block_iterator_first (block, &p_smob->iter); + p_smob->initialized_p = 1; + } + else + sym = block_iterator_next (&p_smob->iter); + + if (sym == NULL) + return gdbscm_end_of_iteration (); + + return syscm_scm_from_symbol (sym); +} + +/* (lookup-block address) -> <gdb:block> + Returns the innermost lexical block containing the specified pc value, + or #f if there is none. */ + +static SCM +gdbscm_lookup_block (SCM pc_scm) +{ + CORE_ADDR pc; + struct block *block = NULL; + struct obj_section *section = NULL; + struct symtab *symtab = NULL; + volatile struct gdb_exception except; + + gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc); + + TRY_CATCH (except, RETURN_MASK_ALL) + { + section = find_pc_mapped_section (pc); + symtab = find_pc_sect_symtab (pc, section); + + if (symtab != NULL && symtab->objfile != NULL) + block = block_for_pc (pc); + } + GDBSCM_HANDLE_GDB_EXCEPTION (except); + + if (symtab == NULL || symtab->objfile == NULL) + { + gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, pc_scm, + _("cannot locate object file for block")); + } + + if (block != NULL) + return bkscm_scm_from_block (block, symtab->objfile); + return SCM_BOOL_F; +} + +/* Initialize the Scheme block support. */ + +static const scheme_function block_functions[] = +{ + { "block?", 1, 0, 0, gdbscm_block_p, + "\ +Return #t if the object is a <gdb:block> object." }, + + { "block-valid?", 1, 0, 0, gdbscm_block_valid_p, + "\ +Return #t if the block is valid.\n\ +A block becomes invalid when its objfile is freed." }, + + { "block-start", 1, 0, 0, gdbscm_block_start, + "\ +Return the start address of the block." }, + + { "block-end", 1, 0, 0, gdbscm_block_end, + "\ +Return the end address of the block." }, + + { "block-function", 1, 0, 0, gdbscm_block_function, + "\ +Return the gdb:symbol object of the function containing the block\n\ +or #f if the block does not live in any function." }, + + { "block-superblock", 1, 0, 0, gdbscm_block_superblock, + "\ +Return the superblock (parent block) of the block." }, + + { "block-global-block", 1, 0, 0, gdbscm_block_global_block, + "\ +Return the global block of the block." }, + + { "block-static-block", 1, 0, 0, gdbscm_block_static_block, + "\ +Return the static block of the block." }, + + { "block-global?", 1, 0, 0, gdbscm_block_global_p, + "\ +Return #t if block is a global block." }, + + { "block-static?", 1, 0, 0, gdbscm_block_static_p, + "\ +Return #t if block is a static block." }, + + { "block-symbols", 1, 0, 0, gdbscm_block_symbols, + "\ +Return a list of all symbols (as <gdb:symbol> objects) in the block." }, + + { "make-block-symbols-iterator", 1, 0, 0, gdbscm_make_block_syms_iter, + "\ +Return a <gdb:iterator> object for iterating over all symbols in the block." }, + + { "block-symbols-progress?", 1, 0, 0, bkscm_block_syms_progress_p, + "\ +Return #t if the object is a <gdb:block-symbols-progress> object." }, + + { "lookup-block", 1, 0, 0, gdbscm_lookup_block, + "\ +Return the innermost GDB block containing the address or #f if none found.\n\ +\n\ + Arguments:\n\ + address: the address to lookup" }, + + END_FUNCTIONS +}; + +void +gdbscm_initialize_blocks (void) +{ + block_smob_tag + = gdbscm_make_smob_type (block_smob_name, sizeof (block_smob)); + scm_set_smob_mark (block_smob_tag, bkscm_mark_block_smob); + scm_set_smob_free (block_smob_tag, bkscm_free_block_smob); + scm_set_smob_print (block_smob_tag, bkscm_print_block_smob); + + block_syms_progress_smob_tag + = gdbscm_make_smob_type (block_syms_progress_smob_name, + sizeof (block_syms_progress_smob)); + scm_set_smob_mark (block_syms_progress_smob_tag, + bkscm_mark_block_syms_progress_smob); + scm_set_smob_print (block_syms_progress_smob_tag, + bkscm_print_block_syms_progress_smob); + + gdbscm_define_functions (block_functions, 1); + + /* This function is "private". */ + bkscm_next_symbol_x_proc + = scm_c_define_gsubr ("%block-next-symbol!", 1, 0, 0, + gdbscm_block_next_symbol_x); + scm_set_procedure_property_x (bkscm_next_symbol_x_proc, + gdbscm_documentation_symbol, + gdbscm_scm_from_c_string ("\ +Internal function to assist the block symbols iterator.")); + + /* Register an objfile "free" callback so we can properly + invalidate blocks when an object file is about to be deleted. */ + bkscm_objfile_data_key + = register_objfile_data_with_cleanup (NULL, bkscm_del_objfile_blocks); +} |