126a53354Schristos /* Scheme interface to symbol tables.
226a53354Schristos
3*1424dfb3Schristos Copyright (C) 2008-2020 Free Software Foundation, Inc.
426a53354Schristos
526a53354Schristos This file is part of GDB.
626a53354Schristos
726a53354Schristos This program is free software; you can redistribute it and/or modify
826a53354Schristos it under the terms of the GNU General Public License as published by
926a53354Schristos the Free Software Foundation; either version 3 of the License, or
1026a53354Schristos (at your option) any later version.
1126a53354Schristos
1226a53354Schristos This program is distributed in the hope that it will be useful,
1326a53354Schristos but WITHOUT ANY WARRANTY; without even the implied warranty of
1426a53354Schristos MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1526a53354Schristos GNU General Public License for more details.
1626a53354Schristos
1726a53354Schristos You should have received a copy of the GNU General Public License
1826a53354Schristos along with this program. If not, see <http://www.gnu.org/licenses/>. */
1926a53354Schristos
2026a53354Schristos /* See README file in this directory for implementation notes, coding
2126a53354Schristos conventions, et.al. */
2226a53354Schristos
2326a53354Schristos #include "defs.h"
2426a53354Schristos #include "symtab.h"
2526a53354Schristos #include "source.h"
2626a53354Schristos #include "objfiles.h"
2726a53354Schristos #include "block.h"
2826a53354Schristos #include "guile-internal.h"
2926a53354Schristos
3026a53354Schristos /* A <gdb:symtab> smob. */
3126a53354Schristos
3226a53354Schristos typedef struct
3326a53354Schristos {
3426a53354Schristos /* This always appears first.
3526a53354Schristos eqable_gdb_smob is used so that symtabs are eq?-able.
3626a53354Schristos Also, a symtab object is associated with an objfile. eqable_gdb_smob
3726a53354Schristos lets us track the lifetime of all symtabs associated with an objfile.
3826a53354Schristos When an objfile is deleted we need to invalidate the symtab object. */
3926a53354Schristos eqable_gdb_smob base;
4026a53354Schristos
4126a53354Schristos /* The GDB symbol table structure.
4226a53354Schristos If this is NULL the symtab is invalid. This can happen when the
4326a53354Schristos underlying objfile is freed. */
4426a53354Schristos struct symtab *symtab;
4526a53354Schristos } symtab_smob;
4626a53354Schristos
4726a53354Schristos /* A <gdb:sal> smob.
4826a53354Schristos A smob describing a gdb symtab-and-line object.
4926a53354Schristos A sal is associated with an objfile. All access must be gated by checking
5026a53354Schristos the validity of symtab_scm.
5126a53354Schristos TODO: Sals are not eq?-able at the moment, or even comparable. */
5226a53354Schristos
5326a53354Schristos typedef struct
5426a53354Schristos {
5526a53354Schristos /* This always appears first. */
5626a53354Schristos gdb_smob base;
5726a53354Schristos
5826a53354Schristos /* The <gdb:symtab> object of the symtab.
5926a53354Schristos We store this instead of a pointer to the symtab_smob because it's not
6026a53354Schristos clear GC will know the symtab_smob is referenced by us otherwise, and we
6126a53354Schristos need quick access to symtab_smob->symtab to know if this sal is valid. */
6226a53354Schristos SCM symtab_scm;
6326a53354Schristos
6426a53354Schristos /* The GDB symbol table and line structure.
6526a53354Schristos This object is ephemeral in GDB, so keep our own copy.
6626a53354Schristos The symtab pointer in this struct is not usable: If the symtab is deleted
6726a53354Schristos this pointer will not be updated. Use symtab_scm instead to determine
6826a53354Schristos if this sal is valid. */
6926a53354Schristos struct symtab_and_line sal;
7026a53354Schristos } sal_smob;
7126a53354Schristos
7226a53354Schristos static const char symtab_smob_name[] = "gdb:symtab";
7326a53354Schristos /* "symtab-and-line" is pretty long, and "sal" is short and unique. */
7426a53354Schristos static const char sal_smob_name[] = "gdb:sal";
7526a53354Schristos
7626a53354Schristos /* The tags Guile knows the symbol table smobs by. */
7726a53354Schristos static scm_t_bits symtab_smob_tag;
7826a53354Schristos static scm_t_bits sal_smob_tag;
7926a53354Schristos
8026a53354Schristos static const struct objfile_data *stscm_objfile_data_key;
8126a53354Schristos
8226a53354Schristos /* Administrivia for symtab smobs. */
8326a53354Schristos
8426a53354Schristos /* Helper function to hash a symbol_smob. */
8526a53354Schristos
8626a53354Schristos static hashval_t
stscm_hash_symtab_smob(const void * p)8726a53354Schristos stscm_hash_symtab_smob (const void *p)
8826a53354Schristos {
89c03b94e9Schristos const symtab_smob *st_smob = (const symtab_smob *) p;
9026a53354Schristos
9126a53354Schristos return htab_hash_pointer (st_smob->symtab);
9226a53354Schristos }
9326a53354Schristos
9426a53354Schristos /* Helper function to compute equality of symtab_smobs. */
9526a53354Schristos
9626a53354Schristos static int
stscm_eq_symtab_smob(const void * ap,const void * bp)9726a53354Schristos stscm_eq_symtab_smob (const void *ap, const void *bp)
9826a53354Schristos {
99c03b94e9Schristos const symtab_smob *a = (const symtab_smob *) ap;
100c03b94e9Schristos const symtab_smob *b = (const symtab_smob *) bp;
10126a53354Schristos
10226a53354Schristos return (a->symtab == b->symtab
10326a53354Schristos && a->symtab != NULL);
10426a53354Schristos }
10526a53354Schristos
10626a53354Schristos /* Return the struct symtab pointer -> SCM mapping table.
10726a53354Schristos It is created if necessary. */
10826a53354Schristos
10926a53354Schristos static htab_t
stscm_objfile_symtab_map(struct symtab * symtab)11026a53354Schristos stscm_objfile_symtab_map (struct symtab *symtab)
11126a53354Schristos {
11226a53354Schristos struct objfile *objfile = SYMTAB_OBJFILE (symtab);
113c03b94e9Schristos htab_t htab = (htab_t) objfile_data (objfile, stscm_objfile_data_key);
11426a53354Schristos
11526a53354Schristos if (htab == NULL)
11626a53354Schristos {
11726a53354Schristos htab = gdbscm_create_eqable_gsmob_ptr_map (stscm_hash_symtab_smob,
11826a53354Schristos stscm_eq_symtab_smob);
11926a53354Schristos set_objfile_data (objfile, stscm_objfile_data_key, htab);
12026a53354Schristos }
12126a53354Schristos
12226a53354Schristos return htab;
12326a53354Schristos }
12426a53354Schristos
12526a53354Schristos /* The smob "free" function for <gdb:symtab>. */
12626a53354Schristos
12726a53354Schristos static size_t
stscm_free_symtab_smob(SCM self)12826a53354Schristos stscm_free_symtab_smob (SCM self)
12926a53354Schristos {
13026a53354Schristos symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self);
13126a53354Schristos
13226a53354Schristos if (st_smob->symtab != NULL)
13326a53354Schristos {
13426a53354Schristos htab_t htab = stscm_objfile_symtab_map (st_smob->symtab);
13526a53354Schristos
13626a53354Schristos gdbscm_clear_eqable_gsmob_ptr_slot (htab, &st_smob->base);
13726a53354Schristos }
13826a53354Schristos
13926a53354Schristos /* Not necessary, done to catch bugs. */
14026a53354Schristos st_smob->symtab = NULL;
14126a53354Schristos
14226a53354Schristos return 0;
14326a53354Schristos }
14426a53354Schristos
14526a53354Schristos /* The smob "print" function for <gdb:symtab>. */
14626a53354Schristos
14726a53354Schristos static int
stscm_print_symtab_smob(SCM self,SCM port,scm_print_state * pstate)14826a53354Schristos stscm_print_symtab_smob (SCM self, SCM port, scm_print_state *pstate)
14926a53354Schristos {
15026a53354Schristos symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (self);
15126a53354Schristos
15226a53354Schristos gdbscm_printf (port, "#<%s ", symtab_smob_name);
15326a53354Schristos gdbscm_printf (port, "%s",
15426a53354Schristos st_smob->symtab != NULL
15526a53354Schristos ? symtab_to_filename_for_display (st_smob->symtab)
15626a53354Schristos : "<invalid>");
15726a53354Schristos scm_puts (">", port);
15826a53354Schristos
15926a53354Schristos scm_remember_upto_here_1 (self);
16026a53354Schristos
16126a53354Schristos /* Non-zero means success. */
16226a53354Schristos return 1;
16326a53354Schristos }
16426a53354Schristos
16526a53354Schristos /* Low level routine to create a <gdb:symtab> object. */
16626a53354Schristos
16726a53354Schristos static SCM
stscm_make_symtab_smob(void)16826a53354Schristos stscm_make_symtab_smob (void)
16926a53354Schristos {
17026a53354Schristos symtab_smob *st_smob = (symtab_smob *)
17126a53354Schristos scm_gc_malloc (sizeof (symtab_smob), symtab_smob_name);
17226a53354Schristos SCM st_scm;
17326a53354Schristos
17426a53354Schristos st_smob->symtab = NULL;
17526a53354Schristos st_scm = scm_new_smob (symtab_smob_tag, (scm_t_bits) st_smob);
17626a53354Schristos gdbscm_init_eqable_gsmob (&st_smob->base, st_scm);
17726a53354Schristos
17826a53354Schristos return st_scm;
17926a53354Schristos }
18026a53354Schristos
18126a53354Schristos /* Return non-zero if SCM is a symbol table smob. */
18226a53354Schristos
18326a53354Schristos static int
stscm_is_symtab(SCM scm)18426a53354Schristos stscm_is_symtab (SCM scm)
18526a53354Schristos {
18626a53354Schristos return SCM_SMOB_PREDICATE (symtab_smob_tag, scm);
18726a53354Schristos }
18826a53354Schristos
18926a53354Schristos /* (symtab? object) -> boolean */
19026a53354Schristos
19126a53354Schristos static SCM
gdbscm_symtab_p(SCM scm)19226a53354Schristos gdbscm_symtab_p (SCM scm)
19326a53354Schristos {
19426a53354Schristos return scm_from_bool (stscm_is_symtab (scm));
19526a53354Schristos }
19626a53354Schristos
19726a53354Schristos /* Create a new <gdb:symtab> object that encapsulates SYMTAB. */
19826a53354Schristos
19926a53354Schristos SCM
stscm_scm_from_symtab(struct symtab * symtab)20026a53354Schristos stscm_scm_from_symtab (struct symtab *symtab)
20126a53354Schristos {
20226a53354Schristos htab_t htab;
20326a53354Schristos eqable_gdb_smob **slot;
20426a53354Schristos symtab_smob *st_smob, st_smob_for_lookup;
20526a53354Schristos SCM st_scm;
20626a53354Schristos
20726a53354Schristos /* If we've already created a gsmob for this symtab, return it.
20826a53354Schristos This makes symtabs eq?-able. */
20926a53354Schristos htab = stscm_objfile_symtab_map (symtab);
21026a53354Schristos st_smob_for_lookup.symtab = symtab;
21126a53354Schristos slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &st_smob_for_lookup.base);
21226a53354Schristos if (*slot != NULL)
21326a53354Schristos return (*slot)->containing_scm;
21426a53354Schristos
21526a53354Schristos st_scm = stscm_make_symtab_smob ();
21626a53354Schristos st_smob = (symtab_smob *) SCM_SMOB_DATA (st_scm);
21726a53354Schristos st_smob->symtab = symtab;
21826a53354Schristos gdbscm_fill_eqable_gsmob_ptr_slot (slot, &st_smob->base);
21926a53354Schristos
22026a53354Schristos return st_scm;
22126a53354Schristos }
22226a53354Schristos
22326a53354Schristos /* Returns the <gdb:symtab> object in SELF.
22426a53354Schristos Throws an exception if SELF is not a <gdb:symtab> object. */
22526a53354Schristos
22626a53354Schristos static SCM
stscm_get_symtab_arg_unsafe(SCM self,int arg_pos,const char * func_name)22726a53354Schristos stscm_get_symtab_arg_unsafe (SCM self, int arg_pos, const char *func_name)
22826a53354Schristos {
22926a53354Schristos SCM_ASSERT_TYPE (stscm_is_symtab (self), self, arg_pos, func_name,
23026a53354Schristos symtab_smob_name);
23126a53354Schristos
23226a53354Schristos return self;
23326a53354Schristos }
23426a53354Schristos
23526a53354Schristos /* Returns a pointer to the symtab smob of SELF.
23626a53354Schristos Throws an exception if SELF is not a <gdb:symtab> object. */
23726a53354Schristos
23826a53354Schristos static symtab_smob *
stscm_get_symtab_smob_arg_unsafe(SCM self,int arg_pos,const char * func_name)23926a53354Schristos stscm_get_symtab_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
24026a53354Schristos {
24126a53354Schristos SCM st_scm = stscm_get_symtab_arg_unsafe (self, arg_pos, func_name);
24226a53354Schristos symtab_smob *st_smob = (symtab_smob *) SCM_SMOB_DATA (st_scm);
24326a53354Schristos
24426a53354Schristos return st_smob;
24526a53354Schristos }
24626a53354Schristos
24726a53354Schristos /* Return non-zero if symtab ST_SMOB is valid. */
24826a53354Schristos
24926a53354Schristos static int
stscm_is_valid(symtab_smob * st_smob)25026a53354Schristos stscm_is_valid (symtab_smob *st_smob)
25126a53354Schristos {
25226a53354Schristos return st_smob->symtab != NULL;
25326a53354Schristos }
25426a53354Schristos
25526a53354Schristos /* Throw a Scheme error if SELF is not a valid symtab smob.
25626a53354Schristos Otherwise return a pointer to the symtab_smob object. */
25726a53354Schristos
25826a53354Schristos static symtab_smob *
stscm_get_valid_symtab_smob_arg_unsafe(SCM self,int arg_pos,const char * func_name)25926a53354Schristos stscm_get_valid_symtab_smob_arg_unsafe (SCM self, int arg_pos,
26026a53354Schristos const char *func_name)
26126a53354Schristos {
26226a53354Schristos symtab_smob *st_smob
26326a53354Schristos = stscm_get_symtab_smob_arg_unsafe (self, arg_pos, func_name);
26426a53354Schristos
26526a53354Schristos if (!stscm_is_valid (st_smob))
26626a53354Schristos {
26726a53354Schristos gdbscm_invalid_object_error (func_name, arg_pos, self,
26826a53354Schristos _("<gdb:symtab>"));
26926a53354Schristos }
27026a53354Schristos
27126a53354Schristos return st_smob;
27226a53354Schristos }
27326a53354Schristos
27426a53354Schristos /* Helper function for stscm_del_objfile_symtabs to mark the symtab
27526a53354Schristos as invalid. */
27626a53354Schristos
27726a53354Schristos static int
stscm_mark_symtab_invalid(void ** slot,void * info)27826a53354Schristos stscm_mark_symtab_invalid (void **slot, void *info)
27926a53354Schristos {
28026a53354Schristos symtab_smob *st_smob = (symtab_smob *) *slot;
28126a53354Schristos
28226a53354Schristos st_smob->symtab = NULL;
28326a53354Schristos return 1;
28426a53354Schristos }
28526a53354Schristos
28626a53354Schristos /* This function is called when an objfile is about to be freed.
28726a53354Schristos Invalidate the symbol table as further actions on the symbol table
28826a53354Schristos would result in bad data. All access to st_smob->symtab should be
28926a53354Schristos gated by stscm_get_valid_symtab_smob_arg_unsafe which will raise an
29026a53354Schristos exception on invalid symbol tables. */
29126a53354Schristos
29226a53354Schristos static void
stscm_del_objfile_symtabs(struct objfile * objfile,void * datum)29326a53354Schristos stscm_del_objfile_symtabs (struct objfile *objfile, void *datum)
29426a53354Schristos {
295c03b94e9Schristos htab_t htab = (htab_t) datum;
29626a53354Schristos
29726a53354Schristos if (htab != NULL)
29826a53354Schristos {
29926a53354Schristos htab_traverse_noresize (htab, stscm_mark_symtab_invalid, NULL);
30026a53354Schristos htab_delete (htab);
30126a53354Schristos }
30226a53354Schristos }
30326a53354Schristos
30426a53354Schristos /* Symbol table methods. */
30526a53354Schristos
30626a53354Schristos /* (symtab-valid? <gdb:symtab>) -> boolean
30726a53354Schristos Returns #t if SELF still exists in GDB. */
30826a53354Schristos
30926a53354Schristos static SCM
gdbscm_symtab_valid_p(SCM self)31026a53354Schristos gdbscm_symtab_valid_p (SCM self)
31126a53354Schristos {
31226a53354Schristos symtab_smob *st_smob
31326a53354Schristos = stscm_get_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
31426a53354Schristos
31526a53354Schristos return scm_from_bool (stscm_is_valid (st_smob));
31626a53354Schristos }
31726a53354Schristos
31826a53354Schristos /* (symtab-filename <gdb:symtab>) -> string */
31926a53354Schristos
32026a53354Schristos static SCM
gdbscm_symtab_filename(SCM self)32126a53354Schristos gdbscm_symtab_filename (SCM self)
32226a53354Schristos {
32326a53354Schristos symtab_smob *st_smob
32426a53354Schristos = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
32526a53354Schristos struct symtab *symtab = st_smob->symtab;
32626a53354Schristos
32726a53354Schristos return gdbscm_scm_from_c_string (symtab_to_filename_for_display (symtab));
32826a53354Schristos }
32926a53354Schristos
33026a53354Schristos /* (symtab-fullname <gdb:symtab>) -> string */
33126a53354Schristos
33226a53354Schristos static SCM
gdbscm_symtab_fullname(SCM self)33326a53354Schristos gdbscm_symtab_fullname (SCM self)
33426a53354Schristos {
33526a53354Schristos symtab_smob *st_smob
33626a53354Schristos = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
33726a53354Schristos struct symtab *symtab = st_smob->symtab;
33826a53354Schristos
33926a53354Schristos return gdbscm_scm_from_c_string (symtab_to_fullname (symtab));
34026a53354Schristos }
34126a53354Schristos
34226a53354Schristos /* (symtab-objfile <gdb:symtab>) -> <gdb:objfile> */
34326a53354Schristos
34426a53354Schristos static SCM
gdbscm_symtab_objfile(SCM self)34526a53354Schristos gdbscm_symtab_objfile (SCM self)
34626a53354Schristos {
34726a53354Schristos symtab_smob *st_smob
34826a53354Schristos = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
34926a53354Schristos const struct symtab *symtab = st_smob->symtab;
35026a53354Schristos
35126a53354Schristos return ofscm_scm_from_objfile (SYMTAB_OBJFILE (symtab));
35226a53354Schristos }
35326a53354Schristos
35426a53354Schristos /* (symtab-global-block <gdb:symtab>) -> <gdb:block>
35526a53354Schristos Return the GLOBAL_BLOCK of the underlying symtab. */
35626a53354Schristos
35726a53354Schristos static SCM
gdbscm_symtab_global_block(SCM self)35826a53354Schristos gdbscm_symtab_global_block (SCM self)
35926a53354Schristos {
36026a53354Schristos symtab_smob *st_smob
36126a53354Schristos = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
36226a53354Schristos const struct symtab *symtab = st_smob->symtab;
36326a53354Schristos const struct blockvector *blockvector;
36426a53354Schristos const struct block *block;
36526a53354Schristos
36626a53354Schristos blockvector = SYMTAB_BLOCKVECTOR (symtab);
36726a53354Schristos block = BLOCKVECTOR_BLOCK (blockvector, GLOBAL_BLOCK);
36826a53354Schristos
36926a53354Schristos return bkscm_scm_from_block (block, SYMTAB_OBJFILE (symtab));
37026a53354Schristos }
37126a53354Schristos
37226a53354Schristos /* (symtab-static-block <gdb:symtab>) -> <gdb:block>
37326a53354Schristos Return the STATIC_BLOCK of the underlying symtab. */
37426a53354Schristos
37526a53354Schristos static SCM
gdbscm_symtab_static_block(SCM self)37626a53354Schristos gdbscm_symtab_static_block (SCM self)
37726a53354Schristos {
37826a53354Schristos symtab_smob *st_smob
37926a53354Schristos = stscm_get_valid_symtab_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
38026a53354Schristos const struct symtab *symtab = st_smob->symtab;
38126a53354Schristos const struct blockvector *blockvector;
38226a53354Schristos const struct block *block;
38326a53354Schristos
38426a53354Schristos blockvector = SYMTAB_BLOCKVECTOR (symtab);
38526a53354Schristos block = BLOCKVECTOR_BLOCK (blockvector, STATIC_BLOCK);
38626a53354Schristos
38726a53354Schristos return bkscm_scm_from_block (block, SYMTAB_OBJFILE (symtab));
38826a53354Schristos }
38926a53354Schristos
39026a53354Schristos /* Administrivia for sal (symtab-and-line) smobs. */
39126a53354Schristos
39226a53354Schristos /* The smob "print" function for <gdb:sal>. */
39326a53354Schristos
39426a53354Schristos static int
stscm_print_sal_smob(SCM self,SCM port,scm_print_state * pstate)39526a53354Schristos stscm_print_sal_smob (SCM self, SCM port, scm_print_state *pstate)
39626a53354Schristos {
39726a53354Schristos sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (self);
39826a53354Schristos
39926a53354Schristos gdbscm_printf (port, "#<%s ", symtab_smob_name);
40026a53354Schristos scm_write (s_smob->symtab_scm, port);
40126a53354Schristos if (s_smob->sal.line != 0)
40226a53354Schristos gdbscm_printf (port, " line %d", s_smob->sal.line);
40326a53354Schristos scm_puts (">", port);
40426a53354Schristos
40526a53354Schristos scm_remember_upto_here_1 (self);
40626a53354Schristos
40726a53354Schristos /* Non-zero means success. */
40826a53354Schristos return 1;
40926a53354Schristos }
41026a53354Schristos
41126a53354Schristos /* Low level routine to create a <gdb:sal> object. */
41226a53354Schristos
41326a53354Schristos static SCM
stscm_make_sal_smob(void)41426a53354Schristos stscm_make_sal_smob (void)
41526a53354Schristos {
41626a53354Schristos sal_smob *s_smob
41726a53354Schristos = (sal_smob *) scm_gc_malloc (sizeof (sal_smob), sal_smob_name);
41826a53354Schristos SCM s_scm;
41926a53354Schristos
42026a53354Schristos s_smob->symtab_scm = SCM_BOOL_F;
42107163879Schristos new (&s_smob->sal) symtab_and_line ();
42226a53354Schristos s_scm = scm_new_smob (sal_smob_tag, (scm_t_bits) s_smob);
42326a53354Schristos gdbscm_init_gsmob (&s_smob->base);
42426a53354Schristos
42526a53354Schristos return s_scm;
42626a53354Schristos }
42726a53354Schristos
42826a53354Schristos /* Return non-zero if SCM is a <gdb:sal> object. */
42926a53354Schristos
43026a53354Schristos static int
stscm_is_sal(SCM scm)43126a53354Schristos stscm_is_sal (SCM scm)
43226a53354Schristos {
43326a53354Schristos return SCM_SMOB_PREDICATE (sal_smob_tag, scm);
43426a53354Schristos }
43526a53354Schristos
43626a53354Schristos /* (sal? object) -> boolean */
43726a53354Schristos
43826a53354Schristos static SCM
gdbscm_sal_p(SCM scm)43926a53354Schristos gdbscm_sal_p (SCM scm)
44026a53354Schristos {
44126a53354Schristos return scm_from_bool (stscm_is_sal (scm));
44226a53354Schristos }
44326a53354Schristos
44426a53354Schristos /* Create a new <gdb:sal> object that encapsulates SAL. */
44526a53354Schristos
44626a53354Schristos SCM
stscm_scm_from_sal(struct symtab_and_line sal)44726a53354Schristos stscm_scm_from_sal (struct symtab_and_line sal)
44826a53354Schristos {
44926a53354Schristos SCM st_scm, s_scm;
45026a53354Schristos sal_smob *s_smob;
45126a53354Schristos
45226a53354Schristos st_scm = SCM_BOOL_F;
45326a53354Schristos if (sal.symtab != NULL)
45426a53354Schristos st_scm = stscm_scm_from_symtab (sal.symtab);
45526a53354Schristos
45626a53354Schristos s_scm = stscm_make_sal_smob ();
45726a53354Schristos s_smob = (sal_smob *) SCM_SMOB_DATA (s_scm);
45826a53354Schristos s_smob->symtab_scm = st_scm;
45926a53354Schristos s_smob->sal = sal;
46026a53354Schristos
46126a53354Schristos return s_scm;
46226a53354Schristos }
46326a53354Schristos
46426a53354Schristos /* Returns the <gdb:sal> object in SELF.
46526a53354Schristos Throws an exception if SELF is not a <gdb:sal> object. */
46626a53354Schristos
46726a53354Schristos static SCM
stscm_get_sal_arg(SCM self,int arg_pos,const char * func_name)46826a53354Schristos stscm_get_sal_arg (SCM self, int arg_pos, const char *func_name)
46926a53354Schristos {
47026a53354Schristos SCM_ASSERT_TYPE (stscm_is_sal (self), self, arg_pos, func_name,
47126a53354Schristos sal_smob_name);
47226a53354Schristos
47326a53354Schristos return self;
47426a53354Schristos }
47526a53354Schristos
47626a53354Schristos /* Returns a pointer to the sal smob of SELF.
47726a53354Schristos Throws an exception if SELF is not a <gdb:sal> object. */
47826a53354Schristos
47926a53354Schristos static sal_smob *
stscm_get_sal_smob_arg(SCM self,int arg_pos,const char * func_name)48026a53354Schristos stscm_get_sal_smob_arg (SCM self, int arg_pos, const char *func_name)
48126a53354Schristos {
48226a53354Schristos SCM s_scm = stscm_get_sal_arg (self, arg_pos, func_name);
48326a53354Schristos sal_smob *s_smob = (sal_smob *) SCM_SMOB_DATA (s_scm);
48426a53354Schristos
48526a53354Schristos return s_smob;
48626a53354Schristos }
48726a53354Schristos
48826a53354Schristos /* Return non-zero if the symtab in S_SMOB is valid. */
48926a53354Schristos
49026a53354Schristos static int
stscm_sal_is_valid(sal_smob * s_smob)49126a53354Schristos stscm_sal_is_valid (sal_smob *s_smob)
49226a53354Schristos {
49326a53354Schristos symtab_smob *st_smob;
49426a53354Schristos
49526a53354Schristos /* If there's no symtab that's ok, the sal is still valid. */
49626a53354Schristos if (gdbscm_is_false (s_smob->symtab_scm))
49726a53354Schristos return 1;
49826a53354Schristos
49926a53354Schristos st_smob = (symtab_smob *) SCM_SMOB_DATA (s_smob->symtab_scm);
50026a53354Schristos
50126a53354Schristos return st_smob->symtab != NULL;
50226a53354Schristos }
50326a53354Schristos
50426a53354Schristos /* Throw a Scheme error if SELF is not a valid sal smob.
50526a53354Schristos Otherwise return a pointer to the sal_smob object. */
50626a53354Schristos
50726a53354Schristos static sal_smob *
stscm_get_valid_sal_smob_arg(SCM self,int arg_pos,const char * func_name)50826a53354Schristos stscm_get_valid_sal_smob_arg (SCM self, int arg_pos, const char *func_name)
50926a53354Schristos {
51026a53354Schristos sal_smob *s_smob = stscm_get_sal_smob_arg (self, arg_pos, func_name);
51126a53354Schristos
51226a53354Schristos if (!stscm_sal_is_valid (s_smob))
51326a53354Schristos {
51426a53354Schristos gdbscm_invalid_object_error (func_name, arg_pos, self,
51526a53354Schristos _("<gdb:sal>"));
51626a53354Schristos }
51726a53354Schristos
51826a53354Schristos return s_smob;
51926a53354Schristos }
52026a53354Schristos
52126a53354Schristos /* sal methods */
52226a53354Schristos
52326a53354Schristos /* (sal-valid? <gdb:sal>) -> boolean
52426a53354Schristos Returns #t if the symtab for SELF still exists in GDB. */
52526a53354Schristos
52626a53354Schristos static SCM
gdbscm_sal_valid_p(SCM self)52726a53354Schristos gdbscm_sal_valid_p (SCM self)
52826a53354Schristos {
52926a53354Schristos sal_smob *s_smob = stscm_get_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
53026a53354Schristos
53126a53354Schristos return scm_from_bool (stscm_sal_is_valid (s_smob));
53226a53354Schristos }
53326a53354Schristos
53426a53354Schristos /* (sal-pc <gdb:sal>) -> address */
53526a53354Schristos
53626a53354Schristos static SCM
gdbscm_sal_pc(SCM self)53726a53354Schristos gdbscm_sal_pc (SCM self)
53826a53354Schristos {
53926a53354Schristos sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
54026a53354Schristos const struct symtab_and_line *sal = &s_smob->sal;
54126a53354Schristos
54226a53354Schristos return gdbscm_scm_from_ulongest (sal->pc);
54326a53354Schristos }
54426a53354Schristos
54526a53354Schristos /* (sal-last <gdb:sal>) -> address
54626a53354Schristos Returns #f if no ending address is recorded. */
54726a53354Schristos
54826a53354Schristos static SCM
gdbscm_sal_last(SCM self)54926a53354Schristos gdbscm_sal_last (SCM self)
55026a53354Schristos {
55126a53354Schristos sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
55226a53354Schristos const struct symtab_and_line *sal = &s_smob->sal;
55326a53354Schristos
55426a53354Schristos if (sal->end > 0)
55526a53354Schristos return gdbscm_scm_from_ulongest (sal->end - 1);
55626a53354Schristos return SCM_BOOL_F;
55726a53354Schristos }
55826a53354Schristos
55926a53354Schristos /* (sal-line <gdb:sal>) -> integer
56026a53354Schristos Returns #f if no line number is recorded. */
56126a53354Schristos
56226a53354Schristos static SCM
gdbscm_sal_line(SCM self)56326a53354Schristos gdbscm_sal_line (SCM self)
56426a53354Schristos {
56526a53354Schristos sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
56626a53354Schristos const struct symtab_and_line *sal = &s_smob->sal;
56726a53354Schristos
56826a53354Schristos if (sal->line > 0)
56926a53354Schristos return scm_from_int (sal->line);
57026a53354Schristos return SCM_BOOL_F;
57126a53354Schristos }
57226a53354Schristos
57326a53354Schristos /* (sal-symtab <gdb:sal>) -> <gdb:symtab>
57426a53354Schristos Returns #f if no symtab is recorded. */
57526a53354Schristos
57626a53354Schristos static SCM
gdbscm_sal_symtab(SCM self)57726a53354Schristos gdbscm_sal_symtab (SCM self)
57826a53354Schristos {
57926a53354Schristos sal_smob *s_smob = stscm_get_valid_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
58026a53354Schristos
58126a53354Schristos return s_smob->symtab_scm;
58226a53354Schristos }
58326a53354Schristos
58426a53354Schristos /* (find-pc-line address) -> <gdb:sal> */
58526a53354Schristos
58626a53354Schristos static SCM
gdbscm_find_pc_line(SCM pc_scm)58726a53354Schristos gdbscm_find_pc_line (SCM pc_scm)
58826a53354Schristos {
58926a53354Schristos ULONGEST pc_ull;
59007163879Schristos symtab_and_line sal;
59126a53354Schristos
59226a53354Schristos gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc_ull);
59326a53354Schristos
594*1424dfb3Schristos gdbscm_gdb_exception exc {};
595*1424dfb3Schristos try
59626a53354Schristos {
59726a53354Schristos CORE_ADDR pc = (CORE_ADDR) pc_ull;
59826a53354Schristos
59926a53354Schristos sal = find_pc_line (pc, 0);
60026a53354Schristos }
601*1424dfb3Schristos catch (const gdb_exception &except)
602ed6a76a9Schristos {
603*1424dfb3Schristos exc = unpack (except);
604ed6a76a9Schristos }
60526a53354Schristos
606*1424dfb3Schristos GDBSCM_HANDLE_GDB_EXCEPTION (exc);
60726a53354Schristos return stscm_scm_from_sal (sal);
60826a53354Schristos }
60926a53354Schristos
61026a53354Schristos /* Initialize the Scheme symbol support. */
61126a53354Schristos
61226a53354Schristos static const scheme_function symtab_functions[] =
61326a53354Schristos {
614c03b94e9Schristos { "symtab?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symtab_p),
61526a53354Schristos "\
61626a53354Schristos Return #t if the object is a <gdb:symtab> object." },
61726a53354Schristos
618c03b94e9Schristos { "symtab-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symtab_valid_p),
61926a53354Schristos "\
62026a53354Schristos Return #t if the symtab still exists in GDB.\n\
62126a53354Schristos Symtabs are deleted when the corresponding objfile is freed." },
62226a53354Schristos
623c03b94e9Schristos { "symtab-filename", 1, 0, 0, as_a_scm_t_subr (gdbscm_symtab_filename),
62426a53354Schristos "\
62526a53354Schristos Return the symtab's source file name." },
62626a53354Schristos
627c03b94e9Schristos { "symtab-fullname", 1, 0, 0, as_a_scm_t_subr (gdbscm_symtab_fullname),
62826a53354Schristos "\
62926a53354Schristos Return the symtab's full source file name." },
63026a53354Schristos
631c03b94e9Schristos { "symtab-objfile", 1, 0, 0, as_a_scm_t_subr (gdbscm_symtab_objfile),
63226a53354Schristos "\
63326a53354Schristos Return the symtab's objfile." },
63426a53354Schristos
635c03b94e9Schristos { "symtab-global-block", 1, 0, 0,
636c03b94e9Schristos as_a_scm_t_subr (gdbscm_symtab_global_block),
63726a53354Schristos "\
63826a53354Schristos Return the symtab's global block." },
63926a53354Schristos
640c03b94e9Schristos { "symtab-static-block", 1, 0, 0,
641c03b94e9Schristos as_a_scm_t_subr (gdbscm_symtab_static_block),
64226a53354Schristos "\
64326a53354Schristos Return the symtab's static block." },
64426a53354Schristos
645c03b94e9Schristos { "sal?", 1, 0, 0, as_a_scm_t_subr (gdbscm_sal_p),
64626a53354Schristos "\
64726a53354Schristos Return #t if the object is a <gdb:sal> (symtab-and-line) object." },
64826a53354Schristos
649c03b94e9Schristos { "sal-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_sal_valid_p),
65026a53354Schristos "\
65126a53354Schristos Return #t if the symtab for the sal still exists in GDB.\n\
65226a53354Schristos Symtabs are deleted when the corresponding objfile is freed." },
65326a53354Schristos
654c03b94e9Schristos { "sal-symtab", 1, 0, 0, as_a_scm_t_subr (gdbscm_sal_symtab),
65526a53354Schristos "\
65626a53354Schristos Return the sal's symtab." },
65726a53354Schristos
658c03b94e9Schristos { "sal-line", 1, 0, 0, as_a_scm_t_subr (gdbscm_sal_line),
65926a53354Schristos "\
66026a53354Schristos Return the sal's line number, or #f if there is none." },
66126a53354Schristos
662c03b94e9Schristos { "sal-pc", 1, 0, 0, as_a_scm_t_subr (gdbscm_sal_pc),
66326a53354Schristos "\
66426a53354Schristos Return the sal's address." },
66526a53354Schristos
666c03b94e9Schristos { "sal-last", 1, 0, 0, as_a_scm_t_subr (gdbscm_sal_last),
66726a53354Schristos "\
66826a53354Schristos Return the last address specified by the sal, or #f if there is none." },
66926a53354Schristos
670c03b94e9Schristos { "find-pc-line", 1, 0, 0, as_a_scm_t_subr (gdbscm_find_pc_line),
67126a53354Schristos "\
67226a53354Schristos Return the sal corresponding to the address, or #f if there isn't one.\n\
67326a53354Schristos \n\
67426a53354Schristos Arguments: address" },
67526a53354Schristos
67626a53354Schristos END_FUNCTIONS
67726a53354Schristos };
67826a53354Schristos
67926a53354Schristos void
gdbscm_initialize_symtabs(void)68026a53354Schristos gdbscm_initialize_symtabs (void)
68126a53354Schristos {
68226a53354Schristos symtab_smob_tag
68326a53354Schristos = gdbscm_make_smob_type (symtab_smob_name, sizeof (symtab_smob));
68426a53354Schristos scm_set_smob_free (symtab_smob_tag, stscm_free_symtab_smob);
68526a53354Schristos scm_set_smob_print (symtab_smob_tag, stscm_print_symtab_smob);
68626a53354Schristos
68726a53354Schristos sal_smob_tag = gdbscm_make_smob_type (sal_smob_name, sizeof (sal_smob));
68826a53354Schristos scm_set_smob_print (sal_smob_tag, stscm_print_sal_smob);
68926a53354Schristos
69026a53354Schristos gdbscm_define_functions (symtab_functions, 1);
69126a53354Schristos
69226a53354Schristos /* Register an objfile "free" callback so we can properly
69326a53354Schristos invalidate symbol tables, and symbol table and line data
69426a53354Schristos structures when an object file that is about to be deleted. */
69526a53354Schristos stscm_objfile_data_key
69626a53354Schristos = register_objfile_data_with_cleanup (NULL, stscm_del_objfile_symtabs);
69726a53354Schristos }
698