| /* Scheme interface to blocks. |
| |
| Copyright (C) 2008-2021 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 |
| (compunit_primary_filetab (cust))); |
| 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 && COMPUNIT_OBJFILE (cust) != NULL) |
| block = block_for_pc (pc); |
| } |
| catch (const gdb_exception &except) |
| { |
| exc = unpack (except); |
| } |
| |
| GDBSCM_HANDLE_GDB_EXCEPTION (exc); |
| if (cust == NULL || COMPUNIT_OBJFILE (cust) == 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, COMPUNIT_OBJFILE (cust)); |
| 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); |
| } |