123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812 |
- /* Scheme interface to blocks.
- Copyright (C) 2008-2022 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. */
- 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;
- };
- /* 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. */
- struct block_syms_progress_smob
- {
- /* 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;
- };
- 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 = (const block_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 = (const block_smob *) ap;
- const block_smob *b = (const block_smob *) 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 = (htab_t) 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 "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", BLOCK_FUNCTION (b)->print_name ());
- 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, b_scm);
- 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);
- 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 = (htab_t) 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 "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 compunit_symtab *cust;
- 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);
- cust = (i_smob->iter.idx == -1
- ? i_smob->iter.d.compunit_symtab
- : i_smob->iter.d.compunit_symtab->includes[i_smob->iter.idx]);
- gdbscm_printf (port, " %s",
- symtab_to_filename_for_display
- (cust->primary_filetab ()));
- 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)
- {
- /* Call for side effects. */
- bkscm_get_valid_block_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- 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;
- const struct block *block = NULL;
- struct compunit_symtab *cust = NULL;
- gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc);
- gdbscm_gdb_exception exc {};
- try
- {
- cust = find_pc_compunit_symtab (pc);
- if (cust != NULL && cust->objfile () != NULL)
- block = block_for_pc (pc);
- }
- catch (const gdb_exception &except)
- {
- exc = unpack (except);
- }
- GDBSCM_HANDLE_GDB_EXCEPTION (exc);
- if (cust == NULL || cust->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, cust->objfile ());
- return SCM_BOOL_F;
- }
- /* Initialize the Scheme block support. */
- static const scheme_function block_functions[] =
- {
- { "block?", 1, 0, 0, as_a_scm_t_subr (gdbscm_block_p),
- "\
- Return #t if the object is a <gdb:block> object." },
- { "block-valid?", 1, 0, 0, as_a_scm_t_subr (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, as_a_scm_t_subr (gdbscm_block_start),
- "\
- Return the start address of the block." },
- { "block-end", 1, 0, 0, as_a_scm_t_subr (gdbscm_block_end),
- "\
- Return the end address of the block." },
- { "block-function", 1, 0, 0, as_a_scm_t_subr (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, as_a_scm_t_subr (gdbscm_block_superblock),
- "\
- Return the superblock (parent block) of the block." },
- { "block-global-block", 1, 0, 0, as_a_scm_t_subr (gdbscm_block_global_block),
- "\
- Return the global block of the block." },
- { "block-static-block", 1, 0, 0, as_a_scm_t_subr (gdbscm_block_static_block),
- "\
- Return the static block of the block." },
- { "block-global?", 1, 0, 0, as_a_scm_t_subr (gdbscm_block_global_p),
- "\
- Return #t if block is a global block." },
- { "block-static?", 1, 0, 0, as_a_scm_t_subr (gdbscm_block_static_p),
- "\
- Return #t if block is a static block." },
- { "block-symbols", 1, 0, 0, as_a_scm_t_subr (gdbscm_block_symbols),
- "\
- Return a list of all symbols (as <gdb:symbol> objects) in the block." },
- { "make-block-symbols-iterator", 1, 0, 0,
- as_a_scm_t_subr (gdbscm_make_block_syms_iter),
- "\
- Return a <gdb:iterator> object for iterating over all symbols in the block." },
- { "block-symbols-progress?", 1, 0, 0,
- as_a_scm_t_subr (bkscm_block_syms_progress_p),
- "\
- Return #t if the object is a <gdb:block-symbols-progress> object." },
- { "lookup-block", 1, 0, 0, as_a_scm_t_subr (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_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_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,
- as_a_scm_t_subr (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."));
- }
- void _initialize_scm_block ();
- void
- _initialize_scm_block ()
- {
- /* 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);
- }
|