scm-symbol.c revision 1.3 1 1.1 christos /* Scheme interface to symbols.
2 1.1 christos
3 1.1 christos Copyright (C) 2008-2015 Free Software Foundation, Inc.
4 1.1 christos
5 1.1 christos This file is part of GDB.
6 1.1 christos
7 1.1 christos This program is free software; you can redistribute it and/or modify
8 1.1 christos it under the terms of the GNU General Public License as published by
9 1.1 christos the Free Software Foundation; either version 3 of the License, or
10 1.1 christos (at your option) any later version.
11 1.1 christos
12 1.1 christos This program is distributed in the hope that it will be useful,
13 1.1 christos but WITHOUT ANY WARRANTY; without even the implied warranty of
14 1.1 christos MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 1.1 christos GNU General Public License for more details.
16 1.1 christos
17 1.1 christos You should have received a copy of the GNU General Public License
18 1.1 christos along with this program. If not, see <http://www.gnu.org/licenses/>. */
19 1.1 christos
20 1.1 christos /* See README file in this directory for implementation notes, coding
21 1.1 christos conventions, et.al. */
22 1.1 christos
23 1.1 christos #include "defs.h"
24 1.1 christos #include "block.h"
25 1.1 christos #include "frame.h"
26 1.1 christos #include "symtab.h"
27 1.1 christos #include "objfiles.h"
28 1.1 christos #include "value.h"
29 1.1 christos #include "guile-internal.h"
30 1.1 christos
31 1.1 christos /* The <gdb:symbol> smob. */
32 1.1 christos
33 1.1 christos typedef struct
34 1.1 christos {
35 1.1 christos /* This always appears first. */
36 1.1 christos eqable_gdb_smob base;
37 1.1 christos
38 1.1 christos /* The GDB symbol structure this smob is wrapping. */
39 1.1 christos struct symbol *symbol;
40 1.1 christos } symbol_smob;
41 1.1 christos
42 1.1 christos static const char symbol_smob_name[] = "gdb:symbol";
43 1.1 christos
44 1.1 christos /* The tag Guile knows the symbol smob by. */
45 1.1 christos static scm_t_bits symbol_smob_tag;
46 1.1 christos
47 1.1 christos /* Keywords used in argument passing. */
48 1.1 christos static SCM block_keyword;
49 1.1 christos static SCM domain_keyword;
50 1.1 christos static SCM frame_keyword;
51 1.1 christos
52 1.1 christos static const struct objfile_data *syscm_objfile_data_key;
53 1.1 christos static struct gdbarch_data *syscm_gdbarch_data_key;
54 1.1 christos
55 1.1 christos struct syscm_gdbarch_data
56 1.1 christos {
57 1.1 christos /* Hash table to implement eqable gdbarch symbols. */
58 1.1 christos htab_t htab;
59 1.1 christos };
60 1.1 christos
61 1.1 christos /* Administrivia for symbol smobs. */
63 1.1 christos
64 1.1 christos /* Helper function to hash a symbol_smob. */
65 1.1 christos
66 1.1 christos static hashval_t
67 1.1 christos syscm_hash_symbol_smob (const void *p)
68 1.1 christos {
69 1.1 christos const symbol_smob *s_smob = p;
70 1.1 christos
71 1.1 christos return htab_hash_pointer (s_smob->symbol);
72 1.1 christos }
73 1.1 christos
74 1.1 christos /* Helper function to compute equality of symbol_smobs. */
75 1.1 christos
76 1.1 christos static int
77 1.1 christos syscm_eq_symbol_smob (const void *ap, const void *bp)
78 1.1 christos {
79 1.1 christos const symbol_smob *a = ap;
80 1.1 christos const symbol_smob *b = bp;
81 1.1 christos
82 1.1 christos return (a->symbol == b->symbol
83 1.1 christos && a->symbol != NULL);
84 1.1 christos }
85 1.1 christos
86 1.1 christos static void *
87 1.1 christos syscm_init_arch_symbols (struct gdbarch *gdbarch)
88 1.1 christos {
89 1.1 christos struct syscm_gdbarch_data *data
90 1.1 christos = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct syscm_gdbarch_data);
91 1.1 christos
92 1.1 christos data->htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob,
93 1.1 christos syscm_eq_symbol_smob);
94 1.1 christos return data;
95 1.1 christos }
96 1.1 christos
97 1.1 christos /* Return the struct symbol pointer -> SCM mapping table.
98 1.1 christos It is created if necessary. */
99 1.1 christos
100 1.1 christos static htab_t
101 1.1 christos syscm_get_symbol_map (struct symbol *symbol)
102 1.1 christos {
103 1.1 christos htab_t htab;
104 1.1 christos
105 1.1 christos if (SYMBOL_OBJFILE_OWNED (symbol))
106 1.1 christos {
107 1.1 christos struct objfile *objfile = symbol_objfile (symbol);
108 1.1 christos
109 1.1 christos htab = objfile_data (objfile, syscm_objfile_data_key);
110 1.1 christos if (htab == NULL)
111 1.1 christos {
112 1.1 christos htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob,
113 1.1 christos syscm_eq_symbol_smob);
114 1.1 christos set_objfile_data (objfile, syscm_objfile_data_key, htab);
115 1.1 christos }
116 1.1 christos }
117 1.1 christos else
118 1.1 christos {
119 1.1 christos struct gdbarch *gdbarch = symbol_arch (symbol);
120 1.1 christos struct syscm_gdbarch_data *data = gdbarch_data (gdbarch,
121 1.1 christos syscm_gdbarch_data_key);
122 1.1 christos
123 1.1 christos htab = data->htab;
124 1.1 christos }
125 1.1 christos
126 1.1 christos return htab;
127 1.1 christos }
128 1.1 christos
129 1.1 christos /* The smob "free" function for <gdb:symbol>. */
130 1.1 christos
131 1.1 christos static size_t
132 1.1 christos syscm_free_symbol_smob (SCM self)
133 1.1 christos {
134 1.1 christos symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
135 1.1 christos
136 1.1 christos if (s_smob->symbol != NULL)
137 1.1 christos {
138 1.1 christos htab_t htab = syscm_get_symbol_map (s_smob->symbol);
139 1.1 christos
140 1.1 christos gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base);
141 1.1 christos }
142 1.1 christos
143 1.1 christos /* Not necessary, done to catch bugs. */
144 1.1 christos s_smob->symbol = NULL;
145 1.1 christos
146 1.1 christos return 0;
147 1.1 christos }
148 1.1 christos
149 1.1 christos /* The smob "print" function for <gdb:symbol>. */
150 1.1 christos
151 1.1 christos static int
152 1.1 christos syscm_print_symbol_smob (SCM self, SCM port, scm_print_state *pstate)
153 1.1 christos {
154 1.1 christos symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
155 1.1 christos
156 1.1 christos if (pstate->writingp)
157 1.1 christos gdbscm_printf (port, "#<%s ", symbol_smob_name);
158 1.1 christos gdbscm_printf (port, "%s",
159 1.1 christos s_smob->symbol != NULL
160 1.1 christos ? SYMBOL_PRINT_NAME (s_smob->symbol)
161 1.1 christos : "<invalid>");
162 1.1 christos if (pstate->writingp)
163 1.1 christos scm_puts (">", port);
164 1.1 christos
165 1.1 christos scm_remember_upto_here_1 (self);
166 1.1 christos
167 1.1 christos /* Non-zero means success. */
168 1.1 christos return 1;
169 1.1 christos }
170 1.1 christos
171 1.1 christos /* Low level routine to create a <gdb:symbol> object. */
172 1.1 christos
173 1.1 christos static SCM
174 1.1 christos syscm_make_symbol_smob (void)
175 1.1 christos {
176 1.1 christos symbol_smob *s_smob = (symbol_smob *)
177 1.1 christos scm_gc_malloc (sizeof (symbol_smob), symbol_smob_name);
178 1.1 christos SCM s_scm;
179 1.1 christos
180 1.1 christos s_smob->symbol = NULL;
181 1.1 christos s_scm = scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob);
182 1.1 christos gdbscm_init_eqable_gsmob (&s_smob->base, s_scm);
183 1.1 christos
184 1.1 christos return s_scm;
185 1.1 christos }
186 1.1 christos
187 1.1 christos /* Return non-zero if SCM is a symbol smob. */
188 1.1 christos
189 1.1 christos int
190 1.1 christos syscm_is_symbol (SCM scm)
191 1.1 christos {
192 1.1 christos return SCM_SMOB_PREDICATE (symbol_smob_tag, scm);
193 1.1 christos }
194 1.1 christos
195 1.1 christos /* (symbol? object) -> boolean */
196 1.1 christos
197 1.1 christos static SCM
198 1.1 christos gdbscm_symbol_p (SCM scm)
199 1.1 christos {
200 1.1 christos return scm_from_bool (syscm_is_symbol (scm));
201 1.1 christos }
202 1.1 christos
203 1.1 christos /* Return the existing object that encapsulates SYMBOL, or create a new
204 1.1 christos <gdb:symbol> object. */
205 1.1 christos
206 1.1 christos SCM
207 1.1 christos syscm_scm_from_symbol (struct symbol *symbol)
208 1.1 christos {
209 1.1 christos htab_t htab;
210 1.1 christos eqable_gdb_smob **slot;
211 1.1 christos symbol_smob *s_smob, s_smob_for_lookup;
212 1.1 christos SCM s_scm;
213 1.1 christos
214 1.1 christos /* If we've already created a gsmob for this symbol, return it.
215 1.1 christos This makes symbols eq?-able. */
216 1.1 christos htab = syscm_get_symbol_map (symbol);
217 1.1 christos s_smob_for_lookup.symbol = symbol;
218 1.1 christos slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &s_smob_for_lookup.base);
219 1.1 christos if (*slot != NULL)
220 1.1 christos return (*slot)->containing_scm;
221 1.1 christos
222 1.1 christos s_scm = syscm_make_symbol_smob ();
223 1.1 christos s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
224 1.1 christos s_smob->symbol = symbol;
225 1.1 christos gdbscm_fill_eqable_gsmob_ptr_slot (slot, &s_smob->base);
226 1.1 christos
227 1.1 christos return s_scm;
228 1.1 christos }
229 1.1 christos
230 1.1 christos /* Returns the <gdb:symbol> object in SELF.
231 1.1 christos Throws an exception if SELF is not a <gdb:symbol> object. */
232 1.1 christos
233 1.1 christos static SCM
234 1.1 christos syscm_get_symbol_arg_unsafe (SCM self, int arg_pos, const char *func_name)
235 1.1 christos {
236 1.1 christos SCM_ASSERT_TYPE (syscm_is_symbol (self), self, arg_pos, func_name,
237 1.1 christos symbol_smob_name);
238 1.1 christos
239 1.1 christos return self;
240 1.1 christos }
241 1.1 christos
242 1.1 christos /* Returns a pointer to the symbol smob of SELF.
243 1.1 christos Throws an exception if SELF is not a <gdb:symbol> object. */
244 1.1 christos
245 1.1 christos static symbol_smob *
246 1.1 christos syscm_get_symbol_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
247 1.1 christos {
248 1.1 christos SCM s_scm = syscm_get_symbol_arg_unsafe (self, arg_pos, func_name);
249 1.1 christos symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
250 1.1 christos
251 1.1 christos return s_smob;
252 1.1 christos }
253 1.1 christos
254 1.1 christos /* Return non-zero if symbol S_SMOB is valid. */
255 1.1 christos
256 1.1 christos static int
257 1.1 christos syscm_is_valid (symbol_smob *s_smob)
258 1.1 christos {
259 1.1 christos return s_smob->symbol != NULL;
260 1.1 christos }
261 1.1 christos
262 1.1 christos /* Throw a Scheme error if SELF is not a valid symbol smob.
263 1.1 christos Otherwise return a pointer to the symbol smob. */
264 1.1 christos
265 1.1 christos static symbol_smob *
266 1.1 christos syscm_get_valid_symbol_smob_arg_unsafe (SCM self, int arg_pos,
267 1.1 christos const char *func_name)
268 1.1 christos {
269 1.1 christos symbol_smob *s_smob
270 1.1 christos = syscm_get_symbol_smob_arg_unsafe (self, arg_pos, func_name);
271 1.1 christos
272 1.1 christos if (!syscm_is_valid (s_smob))
273 1.1 christos {
274 1.1 christos gdbscm_invalid_object_error (func_name, arg_pos, self,
275 1.1 christos _("<gdb:symbol>"));
276 1.1 christos }
277 1.1 christos
278 1.1 christos return s_smob;
279 1.1 christos }
280 1.1 christos
281 1.1 christos /* Throw a Scheme error if SELF is not a valid symbol smob.
282 1.1 christos Otherwise return a pointer to the symbol struct. */
283 1.1 christos
284 1.1 christos struct symbol *
285 1.1 christos syscm_get_valid_symbol_arg_unsafe (SCM self, int arg_pos,
286 1.1 christos const char *func_name)
287 1.1 christos {
288 1.1 christos symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, arg_pos,
289 1.1 christos func_name);
290 1.1 christos
291 1.1 christos return s_smob->symbol;
292 1.1 christos }
293 1.1 christos
294 1.1 christos /* Helper function for syscm_del_objfile_symbols to mark the symbol
295 1.1 christos as invalid. */
296 1.1 christos
297 1.1 christos static int
298 1.1 christos syscm_mark_symbol_invalid (void **slot, void *info)
299 1.1 christos {
300 1.1 christos symbol_smob *s_smob = (symbol_smob *) *slot;
301 1.1 christos
302 1.1 christos s_smob->symbol = NULL;
303 1.1 christos return 1;
304 1.1 christos }
305 1.1 christos
306 1.1 christos /* This function is called when an objfile is about to be freed.
307 1.1 christos Invalidate the symbol as further actions on the symbol would result
308 1.1 christos in bad data. All access to s_smob->symbol should be gated by
309 1.1 christos syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on
310 1.1 christos invalid symbols. */
311 1.1 christos
312 1.1 christos static void
313 1.1 christos syscm_del_objfile_symbols (struct objfile *objfile, void *datum)
314 1.1 christos {
315 1.1 christos htab_t htab = datum;
316 1.1 christos
317 1.1 christos if (htab != NULL)
318 1.1 christos {
319 1.1 christos htab_traverse_noresize (htab, syscm_mark_symbol_invalid, NULL);
320 1.1 christos htab_delete (htab);
321 1.1 christos }
322 1.1 christos }
323 1.1 christos
324 1.1 christos /* Symbol methods. */
326 1.1 christos
327 1.1 christos /* (symbol-valid? <gdb:symbol>) -> boolean
328 1.1 christos Returns #t if SELF still exists in GDB. */
329 1.1 christos
330 1.1 christos static SCM
331 1.1 christos gdbscm_symbol_valid_p (SCM self)
332 1.1 christos {
333 1.1 christos symbol_smob *s_smob
334 1.1 christos = syscm_get_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
335 1.1 christos
336 1.1 christos return scm_from_bool (syscm_is_valid (s_smob));
337 1.1 christos }
338 1.1 christos
339 1.1 christos /* (symbol-type <gdb:symbol>) -> <gdb:type>
340 1.1 christos Return the type of SELF, or #f if SELF has no type. */
341 1.1 christos
342 1.1 christos static SCM
343 1.1 christos gdbscm_symbol_type (SCM self)
344 1.1 christos {
345 1.1 christos symbol_smob *s_smob
346 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
347 1.1 christos const struct symbol *symbol = s_smob->symbol;
348 1.1 christos
349 1.1 christos if (SYMBOL_TYPE (symbol) == NULL)
350 1.1 christos return SCM_BOOL_F;
351 1.1 christos
352 1.1 christos return tyscm_scm_from_type (SYMBOL_TYPE (symbol));
353 1.1 christos }
354 1.1 christos
355 1.1 christos /* (symbol-symtab <gdb:symbol>) -> <gdb:symtab> | #f
356 1.1 christos Return the symbol table of SELF.
357 1.1 christos If SELF does not have a symtab (it is arch-owned) return #f. */
358 1.1 christos
359 1.1 christos static SCM
360 1.1 christos gdbscm_symbol_symtab (SCM self)
361 1.1 christos {
362 1.1 christos symbol_smob *s_smob
363 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
364 1.1 christos const struct symbol *symbol = s_smob->symbol;
365 1.1 christos
366 1.1 christos if (!SYMBOL_OBJFILE_OWNED (symbol))
367 1.1 christos return SCM_BOOL_F;
368 1.1 christos return stscm_scm_from_symtab (symbol_symtab (symbol));
369 1.1 christos }
370 1.1 christos
371 1.1 christos /* (symbol-name <gdb:symbol>) -> string */
372 1.1 christos
373 1.1 christos static SCM
374 1.1 christos gdbscm_symbol_name (SCM self)
375 1.1 christos {
376 1.1 christos symbol_smob *s_smob
377 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
378 1.1 christos const struct symbol *symbol = s_smob->symbol;
379 1.1 christos
380 1.1 christos return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol));
381 1.1 christos }
382 1.1 christos
383 1.1 christos /* (symbol-linkage-name <gdb:symbol>) -> string */
384 1.1 christos
385 1.1 christos static SCM
386 1.1 christos gdbscm_symbol_linkage_name (SCM self)
387 1.1 christos {
388 1.1 christos symbol_smob *s_smob
389 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
390 1.1 christos const struct symbol *symbol = s_smob->symbol;
391 1.1 christos
392 1.1 christos return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol));
393 1.1 christos }
394 1.1 christos
395 1.1 christos /* (symbol-print-name <gdb:symbol>) -> string */
396 1.1 christos
397 1.1 christos static SCM
398 1.1 christos gdbscm_symbol_print_name (SCM self)
399 1.1 christos {
400 1.1 christos symbol_smob *s_smob
401 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
402 1.1 christos const struct symbol *symbol = s_smob->symbol;
403 1.1 christos
404 1.1 christos return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol));
405 1.1 christos }
406 1.1 christos
407 1.1 christos /* (symbol-addr-class <gdb:symbol>) -> integer */
408 1.1 christos
409 1.1 christos static SCM
410 1.1 christos gdbscm_symbol_addr_class (SCM self)
411 1.1 christos {
412 1.1 christos symbol_smob *s_smob
413 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
414 1.1 christos const struct symbol *symbol = s_smob->symbol;
415 1.1 christos
416 1.1 christos return scm_from_int (SYMBOL_CLASS (symbol));
417 1.1 christos }
418 1.1 christos
419 1.1 christos /* (symbol-argument? <gdb:symbol>) -> boolean */
420 1.1 christos
421 1.1 christos static SCM
422 1.1 christos gdbscm_symbol_argument_p (SCM self)
423 1.1 christos {
424 1.1 christos symbol_smob *s_smob
425 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
426 1.1 christos const struct symbol *symbol = s_smob->symbol;
427 1.1 christos
428 1.1 christos return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol));
429 1.1 christos }
430 1.1 christos
431 1.1 christos /* (symbol-constant? <gdb:symbol>) -> boolean */
432 1.1 christos
433 1.1 christos static SCM
434 1.1 christos gdbscm_symbol_constant_p (SCM self)
435 1.1 christos {
436 1.1 christos symbol_smob *s_smob
437 1.3 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
438 1.1 christos const struct symbol *symbol = s_smob->symbol;
439 1.3 christos enum address_class theclass;
440 1.1 christos
441 1.3 christos theclass = SYMBOL_CLASS (symbol);
442 1.1 christos
443 1.1 christos return scm_from_bool (theclass == LOC_CONST || theclass == LOC_CONST_BYTES);
444 1.1 christos }
445 1.1 christos
446 1.1 christos /* (symbol-function? <gdb:symbol>) -> boolean */
447 1.1 christos
448 1.1 christos static SCM
449 1.1 christos gdbscm_symbol_function_p (SCM self)
450 1.1 christos {
451 1.1 christos symbol_smob *s_smob
452 1.3 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
453 1.1 christos const struct symbol *symbol = s_smob->symbol;
454 1.3 christos enum address_class theclass;
455 1.1 christos
456 1.3 christos theclass = SYMBOL_CLASS (symbol);
457 1.1 christos
458 1.1 christos return scm_from_bool (theclass == LOC_BLOCK);
459 1.1 christos }
460 1.1 christos
461 1.1 christos /* (symbol-variable? <gdb:symbol>) -> boolean */
462 1.1 christos
463 1.1 christos static SCM
464 1.1 christos gdbscm_symbol_variable_p (SCM self)
465 1.1 christos {
466 1.1 christos symbol_smob *s_smob
467 1.3 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
468 1.1 christos const struct symbol *symbol = s_smob->symbol;
469 1.3 christos enum address_class theclass;
470 1.1 christos
471 1.1 christos theclass = SYMBOL_CLASS (symbol);
472 1.3 christos
473 1.3 christos return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol)
474 1.3 christos && (theclass == LOC_LOCAL || theclass == LOC_REGISTER
475 1.1 christos || theclass == LOC_STATIC || theclass == LOC_COMPUTED
476 1.1 christos || theclass == LOC_OPTIMIZED_OUT));
477 1.1 christos }
478 1.1 christos
479 1.1 christos /* (symbol-needs-frame? <gdb:symbol>) -> boolean
480 1.1 christos Return #t if the symbol needs a frame for evaluation. */
481 1.1 christos
482 1.1 christos static SCM
483 1.1 christos gdbscm_symbol_needs_frame_p (SCM self)
484 1.1 christos {
485 1.1 christos symbol_smob *s_smob
486 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
487 1.1 christos struct symbol *symbol = s_smob->symbol;
488 1.3 christos int result = 0;
489 1.1 christos
490 1.1 christos TRY
491 1.1 christos {
492 1.3 christos result = symbol_read_needs_frame (symbol);
493 1.3 christos }
494 1.3 christos CATCH (except, RETURN_MASK_ALL)
495 1.3 christos {
496 1.3 christos GDBSCM_HANDLE_GDB_EXCEPTION (except);
497 1.1 christos }
498 1.1 christos END_CATCH
499 1.1 christos
500 1.1 christos return scm_from_bool (result);
501 1.1 christos }
502 1.1 christos
503 1.1 christos /* (symbol-line <gdb:symbol>) -> integer
504 1.1 christos Return the line number at which the symbol was defined. */
505 1.1 christos
506 1.1 christos static SCM
507 1.1 christos gdbscm_symbol_line (SCM self)
508 1.1 christos {
509 1.1 christos symbol_smob *s_smob
510 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
511 1.1 christos const struct symbol *symbol = s_smob->symbol;
512 1.1 christos
513 1.1 christos return scm_from_int (SYMBOL_LINE (symbol));
514 1.1 christos }
515 1.1 christos
516 1.1 christos /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
517 1.1 christos Return the value of the symbol, or an error in various circumstances. */
518 1.1 christos
519 1.1 christos static SCM
520 1.1 christos gdbscm_symbol_value (SCM self, SCM rest)
521 1.1 christos {
522 1.1 christos symbol_smob *s_smob
523 1.1 christos = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
524 1.1 christos struct symbol *symbol = s_smob->symbol;
525 1.1 christos SCM keywords[] = { frame_keyword, SCM_BOOL_F };
526 1.1 christos int frame_pos = -1;
527 1.1 christos SCM frame_scm = SCM_BOOL_F;
528 1.1 christos frame_smob *f_smob = NULL;
529 1.1 christos struct frame_info *frame_info = NULL;
530 1.1 christos struct value *value = NULL;
531 1.1 christos
532 1.1 christos gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O",
533 1.1 christos rest, &frame_pos, &frame_scm);
534 1.1 christos if (!gdbscm_is_false (frame_scm))
535 1.1 christos f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME);
536 1.1 christos
537 1.1 christos if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF)
538 1.1 christos {
539 1.1 christos gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
540 1.1 christos _("cannot get the value of a typedef"));
541 1.3 christos }
542 1.1 christos
543 1.1 christos TRY
544 1.1 christos {
545 1.1 christos if (f_smob != NULL)
546 1.1 christos {
547 1.1 christos frame_info = frscm_frame_smob_to_frame (f_smob);
548 1.1 christos if (frame_info == NULL)
549 1.1 christos error (_("Invalid frame"));
550 1.1 christos }
551 1.1 christos
552 1.1 christos if (symbol_read_needs_frame (symbol) && frame_info == NULL)
553 1.1 christos error (_("Symbol requires a frame to compute its value"));
554 1.1 christos
555 1.3 christos value = read_var_value (symbol, frame_info);
556 1.3 christos }
557 1.3 christos CATCH (except, RETURN_MASK_ALL)
558 1.3 christos {
559 1.3 christos GDBSCM_HANDLE_GDB_EXCEPTION (except);
560 1.1 christos }
561 1.1 christos END_CATCH
562 1.1 christos
563 1.1 christos return vlscm_scm_from_value (value);
564 1.1 christos }
565 1.1 christos
566 1.1 christos /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
568 1.1 christos -> (<gdb:symbol> field-of-this?)
569 1.1 christos The result is #f if the symbol is not found.
570 1.1 christos See comment in lookup_symbol_in_language for field-of-this?. */
571 1.1 christos
572 1.1 christos static SCM
573 1.1 christos gdbscm_lookup_symbol (SCM name_scm, SCM rest)
574 1.1 christos {
575 1.1 christos char *name;
576 1.1 christos SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F };
577 1.1 christos const struct block *block = NULL;
578 1.1 christos SCM block_scm = SCM_BOOL_F;
579 1.1 christos int domain = VAR_DOMAIN;
580 1.1 christos int block_arg_pos = -1, domain_arg_pos = -1;
581 1.3 christos struct field_of_this_result is_a_field_of_this;
582 1.1 christos struct symbol *symbol = NULL;
583 1.1 christos struct cleanup *cleanups;
584 1.1 christos struct gdb_exception except = exception_none;
585 1.1 christos
586 1.1 christos gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
587 1.1 christos name_scm, &name, rest,
588 1.1 christos &block_arg_pos, &block_scm,
589 1.1 christos &domain_arg_pos, &domain);
590 1.1 christos
591 1.1 christos cleanups = make_cleanup (xfree, name);
592 1.1 christos
593 1.1 christos if (block_arg_pos >= 0)
594 1.1 christos {
595 1.1 christos SCM except_scm;
596 1.1 christos
597 1.1 christos block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
598 1.1 christos &except_scm);
599 1.1 christos if (block == NULL)
600 1.1 christos {
601 1.1 christos do_cleanups (cleanups);
602 1.1 christos gdbscm_throw (except_scm);
603 1.1 christos }
604 1.1 christos }
605 1.1 christos else
606 1.3 christos {
607 1.1 christos struct frame_info *selected_frame;
608 1.1 christos
609 1.1 christos TRY
610 1.1 christos {
611 1.3 christos selected_frame = get_selected_frame (_("no frame selected"));
612 1.3 christos block = get_frame_block (selected_frame, NULL);
613 1.3 christos }
614 1.3 christos CATCH (except, RETURN_MASK_ALL)
615 1.3 christos {
616 1.1 christos GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
617 1.1 christos }
618 1.3 christos END_CATCH
619 1.1 christos }
620 1.1 christos
621 1.1 christos TRY
622 1.3 christos {
623 1.3 christos symbol = lookup_symbol (name, block, domain, &is_a_field_of_this);
624 1.3 christos }
625 1.3 christos CATCH (ex, RETURN_MASK_ALL)
626 1.3 christos {
627 1.3 christos except = ex;
628 1.1 christos }
629 1.1 christos END_CATCH
630 1.1 christos
631 1.1 christos do_cleanups (cleanups);
632 1.1 christos GDBSCM_HANDLE_GDB_EXCEPTION (except);
633 1.1 christos
634 1.1 christos if (symbol == NULL)
635 1.1 christos return SCM_BOOL_F;
636 1.1 christos
637 1.1 christos return scm_list_2 (syscm_scm_from_symbol (symbol),
638 1.1 christos scm_from_bool (is_a_field_of_this.type != NULL));
639 1.1 christos }
640 1.1 christos
641 1.1 christos /* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol>
642 1.1 christos The result is #f if the symbol is not found. */
643 1.1 christos
644 1.1 christos static SCM
645 1.1 christos gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
646 1.1 christos {
647 1.1 christos char *name;
648 1.1 christos SCM keywords[] = { domain_keyword, SCM_BOOL_F };
649 1.1 christos int domain_arg_pos = -1;
650 1.3 christos int domain = VAR_DOMAIN;
651 1.1 christos struct symbol *symbol = NULL;
652 1.1 christos struct cleanup *cleanups;
653 1.1 christos struct gdb_exception except = exception_none;
654 1.1 christos
655 1.1 christos gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
656 1.1 christos name_scm, &name, rest,
657 1.1 christos &domain_arg_pos, &domain);
658 1.3 christos
659 1.1 christos cleanups = make_cleanup (xfree, name);
660 1.1 christos
661 1.1 christos TRY
662 1.3 christos {
663 1.3 christos symbol = lookup_global_symbol (name, NULL, domain);
664 1.3 christos }
665 1.3 christos CATCH (ex, RETURN_MASK_ALL)
666 1.3 christos {
667 1.3 christos except = ex;
668 1.1 christos }
669 1.1 christos END_CATCH
670 1.1 christos
671 1.1 christos do_cleanups (cleanups);
672 1.1 christos GDBSCM_HANDLE_GDB_EXCEPTION (except);
673 1.1 christos
674 1.1 christos if (symbol == NULL)
675 1.1 christos return SCM_BOOL_F;
676 1.1 christos
677 1.1 christos return syscm_scm_from_symbol (symbol);
678 1.1 christos }
679 1.1 christos
680 1.1 christos /* Initialize the Scheme symbol support. */
682 1.1 christos
683 1.1 christos /* Note: The SYMBOL_ prefix on the integer constants here is present for
684 1.1 christos compatibility with the Python support. */
685 1.1 christos
686 1.1 christos static const scheme_integer_constant symbol_integer_constants[] =
687 1.1 christos {
688 1.1 christos #define X(SYM) { "SYMBOL_" #SYM, SYM }
689 1.1 christos X (LOC_UNDEF),
690 1.1 christos X (LOC_CONST),
691 1.1 christos X (LOC_STATIC),
692 1.1 christos X (LOC_REGISTER),
693 1.1 christos X (LOC_ARG),
694 1.1 christos X (LOC_REF_ARG),
695 1.1 christos X (LOC_LOCAL),
696 1.1 christos X (LOC_TYPEDEF),
697 1.1 christos X (LOC_LABEL),
698 1.1 christos X (LOC_BLOCK),
699 1.1 christos X (LOC_CONST_BYTES),
700 1.1 christos X (LOC_UNRESOLVED),
701 1.1 christos X (LOC_OPTIMIZED_OUT),
702 1.1 christos X (LOC_COMPUTED),
703 1.1 christos X (LOC_REGPARM_ADDR),
704 1.1 christos
705 1.1 christos X (UNDEF_DOMAIN),
706 1.1 christos X (VAR_DOMAIN),
707 1.1 christos X (STRUCT_DOMAIN),
708 1.1 christos X (LABEL_DOMAIN),
709 1.1 christos X (VARIABLES_DOMAIN),
710 1.1 christos X (FUNCTIONS_DOMAIN),
711 1.1 christos X (TYPES_DOMAIN),
712 1.1 christos #undef X
713 1.1 christos
714 1.1 christos END_INTEGER_CONSTANTS
715 1.1 christos };
716 1.1 christos
717 1.1 christos static const scheme_function symbol_functions[] =
718 1.1 christos {
719 1.1 christos { "symbol?", 1, 0, 0, gdbscm_symbol_p,
720 1.1 christos "\
721 1.1 christos Return #t if the object is a <gdb:symbol> object." },
722 1.1 christos
723 1.1 christos { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p,
724 1.1 christos "\
725 1.1 christos Return #t if object is a valid <gdb:symbol> object.\n\
726 1.1 christos A valid symbol is a symbol that has not been freed.\n\
727 1.1 christos Symbols are freed when the objfile they come from is freed." },
728 1.1 christos
729 1.1 christos { "symbol-type", 1, 0, 0, gdbscm_symbol_type,
730 1.1 christos "\
731 1.1 christos Return the type of symbol." },
732 1.1 christos
733 1.1 christos { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab,
734 1.1 christos "\
735 1.1 christos Return the symbol table (<gdb:symtab>) containing symbol." },
736 1.1 christos
737 1.1 christos { "symbol-line", 1, 0, 0, gdbscm_symbol_line,
738 1.1 christos "\
739 1.1 christos Return the line number at which the symbol was defined." },
740 1.1 christos
741 1.1 christos { "symbol-name", 1, 0, 0, gdbscm_symbol_name,
742 1.1 christos "\
743 1.1 christos Return the name of the symbol as a string." },
744 1.1 christos
745 1.1 christos { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name,
746 1.1 christos "\
747 1.1 christos Return the linkage name of the symbol as a string." },
748 1.1 christos
749 1.1 christos { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name,
750 1.1 christos "\
751 1.1 christos Return the print name of the symbol as a string.\n\
752 1.1 christos This is either name or linkage-name, depending on whether the user\n\
753 1.1 christos asked GDB to display demangled or mangled names." },
754 1.1 christos
755 1.1 christos { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class,
756 1.1 christos "\
757 1.1 christos Return the address class of the symbol." },
758 1.1 christos
759 1.1 christos { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p,
760 1.1 christos "\
761 1.1 christos Return #t if the symbol needs a frame to compute its value." },
762 1.1 christos
763 1.1 christos { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p,
764 1.1 christos "\
765 1.1 christos Return #t if the symbol is a function argument." },
766 1.1 christos
767 1.1 christos { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p,
768 1.1 christos "\
769 1.1 christos Return #t if the symbol is a constant." },
770 1.1 christos
771 1.1 christos { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p,
772 1.1 christos "\
773 1.1 christos Return #t if the symbol is a function." },
774 1.1 christos
775 1.1 christos { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p,
776 1.1 christos "\
777 1.1 christos Return #t if the symbol is a variable." },
778 1.1 christos
779 1.1 christos { "symbol-value", 1, 0, 1, gdbscm_symbol_value,
780 1.1 christos "\
781 1.1 christos Return the value of the symbol.\n\
782 1.1 christos \n\
783 1.1 christos Arguments: <gdb:symbol> [#:frame frame]" },
784 1.1 christos
785 1.1 christos { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol,
786 1.1 christos "\
787 1.1 christos Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
788 1.1 christos \n\
789 1.1 christos Arguments: name [#:block block] [#:domain domain]\n\
790 1.1 christos name: a string containing the name of the symbol to lookup\n\
791 1.1 christos block: a <gdb:block> object\n\
792 1.1 christos domain: a SYMBOL_*_DOMAIN value" },
793 1.1 christos
794 1.1 christos { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol,
795 1.1 christos "\
796 1.1 christos Return <gdb:symbol> if found, otherwise #f.\n\
797 1.1 christos \n\
798 1.1 christos Arguments: name [#:domain domain]\n\
799 1.1 christos name: a string containing the name of the symbol to lookup\n\
800 1.1 christos domain: a SYMBOL_*_DOMAIN value" },
801 1.1 christos
802 1.1 christos END_FUNCTIONS
803 1.1 christos };
804 1.1 christos
805 1.1 christos void
806 1.1 christos gdbscm_initialize_symbols (void)
807 1.1 christos {
808 1.1 christos symbol_smob_tag
809 1.1 christos = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob));
810 1.1 christos scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob);
811 1.1 christos scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob);
812 1.1 christos
813 1.1 christos gdbscm_define_integer_constants (symbol_integer_constants, 1);
814 1.1 christos gdbscm_define_functions (symbol_functions, 1);
815 1.1 christos
816 1.1 christos block_keyword = scm_from_latin1_keyword ("block");
817 1.1 christos domain_keyword = scm_from_latin1_keyword ("domain");
818 1.1 christos frame_keyword = scm_from_latin1_keyword ("frame");
819 1.1 christos
820 1.1 christos /* Register an objfile "free" callback so we can properly
821 1.1 christos invalidate symbols when an object file is about to be deleted. */
822 1.1 christos syscm_objfile_data_key
823 1.1 christos = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols);
824 1.1 christos
825 /* Arch-specific symbol data. */
826 syscm_gdbarch_data_key
827 = gdbarch_data_register_post_init (syscm_init_arch_symbols);
828 }
829