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