Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Scheme interface to symbols. |
2 | ||
618f726f | 3 | Copyright (C) 2008-2016 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 | ||
492d29ea | 489 | TRY |
ed3ef339 DE |
490 | { |
491 | result = symbol_read_needs_frame (symbol); | |
492 | } | |
492d29ea PA |
493 | CATCH (except, RETURN_MASK_ALL) |
494 | { | |
495 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
496 | } | |
497 | END_CATCH | |
ed3ef339 DE |
498 | |
499 | return scm_from_bool (result); | |
500 | } | |
501 | ||
502 | /* (symbol-line <gdb:symbol>) -> integer | |
503 | Return the line number at which the symbol was defined. */ | |
504 | ||
505 | static SCM | |
506 | gdbscm_symbol_line (SCM self) | |
507 | { | |
508 | symbol_smob *s_smob | |
509 | = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
510 | const struct symbol *symbol = s_smob->symbol; | |
511 | ||
512 | return scm_from_int (SYMBOL_LINE (symbol)); | |
513 | } | |
514 | ||
515 | /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value> | |
516 | Return the value of the symbol, or an error in various circumstances. */ | |
517 | ||
518 | static SCM | |
519 | gdbscm_symbol_value (SCM self, SCM rest) | |
520 | { | |
521 | symbol_smob *s_smob | |
522 | = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
523 | struct symbol *symbol = s_smob->symbol; | |
524 | SCM keywords[] = { frame_keyword, SCM_BOOL_F }; | |
525 | int frame_pos = -1; | |
526 | SCM frame_scm = SCM_BOOL_F; | |
527 | frame_smob *f_smob = NULL; | |
528 | struct frame_info *frame_info = NULL; | |
529 | struct value *value = NULL; | |
ed3ef339 DE |
530 | |
531 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", | |
532 | rest, &frame_pos, &frame_scm); | |
533 | if (!gdbscm_is_false (frame_scm)) | |
534 | f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME); | |
535 | ||
536 | if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF) | |
537 | { | |
538 | gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, | |
539 | _("cannot get the value of a typedef")); | |
540 | } | |
541 | ||
492d29ea | 542 | TRY |
ed3ef339 DE |
543 | { |
544 | if (f_smob != NULL) | |
545 | { | |
546 | frame_info = frscm_frame_smob_to_frame (f_smob); | |
547 | if (frame_info == NULL) | |
548 | error (_("Invalid frame")); | |
549 | } | |
550 | ||
551 | if (symbol_read_needs_frame (symbol) && frame_info == NULL) | |
552 | error (_("Symbol requires a frame to compute its value")); | |
553 | ||
63e43d3a PMR |
554 | /* TODO: currently, we have no way to recover the block in which SYMBOL |
555 | was found, so we have no block to pass to read_var_value. This will | |
556 | yield an incorrect value when symbol is not local to FRAME_INFO (this | |
557 | can happen with nested functions). */ | |
558 | value = read_var_value (symbol, NULL, frame_info); | |
ed3ef339 | 559 | } |
492d29ea PA |
560 | CATCH (except, RETURN_MASK_ALL) |
561 | { | |
562 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
563 | } | |
564 | END_CATCH | |
ed3ef339 DE |
565 | |
566 | return vlscm_scm_from_value (value); | |
567 | } | |
568 | \f | |
569 | /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain]) | |
570 | -> (<gdb:symbol> field-of-this?) | |
571 | The result is #f if the symbol is not found. | |
572 | See comment in lookup_symbol_in_language for field-of-this?. */ | |
573 | ||
574 | static SCM | |
575 | gdbscm_lookup_symbol (SCM name_scm, SCM rest) | |
576 | { | |
577 | char *name; | |
578 | SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F }; | |
579 | const struct block *block = NULL; | |
580 | SCM block_scm = SCM_BOOL_F; | |
581 | int domain = VAR_DOMAIN; | |
582 | int block_arg_pos = -1, domain_arg_pos = -1; | |
583 | struct field_of_this_result is_a_field_of_this; | |
584 | struct symbol *symbol = NULL; | |
ed3ef339 | 585 | struct cleanup *cleanups; |
492d29ea | 586 | struct gdb_exception except = exception_none; |
ed3ef339 DE |
587 | |
588 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi", | |
589 | name_scm, &name, rest, | |
590 | &block_arg_pos, &block_scm, | |
591 | &domain_arg_pos, &domain); | |
592 | ||
593 | cleanups = make_cleanup (xfree, name); | |
594 | ||
595 | if (block_arg_pos >= 0) | |
596 | { | |
597 | SCM except_scm; | |
598 | ||
599 | block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME, | |
600 | &except_scm); | |
601 | if (block == NULL) | |
602 | { | |
603 | do_cleanups (cleanups); | |
604 | gdbscm_throw (except_scm); | |
605 | } | |
606 | } | |
607 | else | |
608 | { | |
609 | struct frame_info *selected_frame; | |
610 | ||
492d29ea | 611 | TRY |
ed3ef339 DE |
612 | { |
613 | selected_frame = get_selected_frame (_("no frame selected")); | |
614 | block = get_frame_block (selected_frame, NULL); | |
615 | } | |
492d29ea PA |
616 | CATCH (except, RETURN_MASK_ALL) |
617 | { | |
618 | GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups); | |
619 | } | |
620 | END_CATCH | |
ed3ef339 DE |
621 | } |
622 | ||
492d29ea | 623 | TRY |
ed3ef339 | 624 | { |
74ef968f SM |
625 | symbol = lookup_symbol (name, block, (domain_enum) domain, |
626 | &is_a_field_of_this).symbol; | |
ed3ef339 | 627 | } |
492d29ea PA |
628 | CATCH (ex, RETURN_MASK_ALL) |
629 | { | |
630 | except = ex; | |
631 | } | |
632 | END_CATCH | |
633 | ||
ed3ef339 DE |
634 | do_cleanups (cleanups); |
635 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
636 | ||
637 | if (symbol == NULL) | |
638 | return SCM_BOOL_F; | |
639 | ||
640 | return scm_list_2 (syscm_scm_from_symbol (symbol), | |
641 | scm_from_bool (is_a_field_of_this.type != NULL)); | |
642 | } | |
643 | ||
644 | /* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol> | |
645 | The result is #f if the symbol is not found. */ | |
646 | ||
647 | static SCM | |
648 | gdbscm_lookup_global_symbol (SCM name_scm, SCM rest) | |
649 | { | |
650 | char *name; | |
651 | SCM keywords[] = { domain_keyword, SCM_BOOL_F }; | |
652 | int domain_arg_pos = -1; | |
653 | int domain = VAR_DOMAIN; | |
654 | struct symbol *symbol = NULL; | |
ed3ef339 | 655 | struct cleanup *cleanups; |
492d29ea | 656 | struct gdb_exception except = exception_none; |
ed3ef339 DE |
657 | |
658 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i", | |
659 | name_scm, &name, rest, | |
660 | &domain_arg_pos, &domain); | |
661 | ||
662 | cleanups = make_cleanup (xfree, name); | |
663 | ||
492d29ea | 664 | TRY |
ed3ef339 | 665 | { |
74ef968f | 666 | symbol = lookup_global_symbol (name, NULL, (domain_enum) domain).symbol; |
ed3ef339 | 667 | } |
492d29ea PA |
668 | CATCH (ex, RETURN_MASK_ALL) |
669 | { | |
670 | except = ex; | |
671 | } | |
672 | END_CATCH | |
673 | ||
ed3ef339 DE |
674 | do_cleanups (cleanups); |
675 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
676 | ||
677 | if (symbol == NULL) | |
678 | return SCM_BOOL_F; | |
679 | ||
680 | return syscm_scm_from_symbol (symbol); | |
681 | } | |
682 | \f | |
683 | /* Initialize the Scheme symbol support. */ | |
684 | ||
685 | /* Note: The SYMBOL_ prefix on the integer constants here is present for | |
686 | compatibility with the Python support. */ | |
687 | ||
688 | static const scheme_integer_constant symbol_integer_constants[] = | |
689 | { | |
690 | #define X(SYM) { "SYMBOL_" #SYM, SYM } | |
691 | X (LOC_UNDEF), | |
692 | X (LOC_CONST), | |
693 | X (LOC_STATIC), | |
694 | X (LOC_REGISTER), | |
695 | X (LOC_ARG), | |
696 | X (LOC_REF_ARG), | |
697 | X (LOC_LOCAL), | |
698 | X (LOC_TYPEDEF), | |
699 | X (LOC_LABEL), | |
700 | X (LOC_BLOCK), | |
701 | X (LOC_CONST_BYTES), | |
702 | X (LOC_UNRESOLVED), | |
703 | X (LOC_OPTIMIZED_OUT), | |
704 | X (LOC_COMPUTED), | |
705 | X (LOC_REGPARM_ADDR), | |
706 | ||
707 | X (UNDEF_DOMAIN), | |
708 | X (VAR_DOMAIN), | |
709 | X (STRUCT_DOMAIN), | |
710 | X (LABEL_DOMAIN), | |
711 | X (VARIABLES_DOMAIN), | |
712 | X (FUNCTIONS_DOMAIN), | |
713 | X (TYPES_DOMAIN), | |
714 | #undef X | |
715 | ||
716 | END_INTEGER_CONSTANTS | |
717 | }; | |
718 | ||
719 | static const scheme_function symbol_functions[] = | |
720 | { | |
72e02483 | 721 | { "symbol?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_p), |
ed3ef339 DE |
722 | "\ |
723 | Return #t if the object is a <gdb:symbol> object." }, | |
724 | ||
72e02483 | 725 | { "symbol-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_valid_p), |
ed3ef339 DE |
726 | "\ |
727 | Return #t if object is a valid <gdb:symbol> object.\n\ | |
728 | A valid symbol is a symbol that has not been freed.\n\ | |
729 | Symbols are freed when the objfile they come from is freed." }, | |
730 | ||
72e02483 | 731 | { "symbol-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_type), |
ed3ef339 DE |
732 | "\ |
733 | Return the type of symbol." }, | |
734 | ||
72e02483 | 735 | { "symbol-symtab", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_symtab), |
ed3ef339 DE |
736 | "\ |
737 | Return the symbol table (<gdb:symtab>) containing symbol." }, | |
738 | ||
72e02483 | 739 | { "symbol-line", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_line), |
ed3ef339 DE |
740 | "\ |
741 | Return the line number at which the symbol was defined." }, | |
742 | ||
72e02483 | 743 | { "symbol-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_name), |
ed3ef339 DE |
744 | "\ |
745 | Return the name of the symbol as a string." }, | |
746 | ||
72e02483 PA |
747 | { "symbol-linkage-name", 1, 0, 0, |
748 | as_a_scm_t_subr (gdbscm_symbol_linkage_name), | |
ed3ef339 DE |
749 | "\ |
750 | Return the linkage name of the symbol as a string." }, | |
751 | ||
72e02483 | 752 | { "symbol-print-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_print_name), |
ed3ef339 DE |
753 | "\ |
754 | Return the print name of the symbol as a string.\n\ | |
755 | This is either name or linkage-name, depending on whether the user\n\ | |
756 | asked GDB to display demangled or mangled names." }, | |
757 | ||
72e02483 | 758 | { "symbol-addr-class", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_addr_class), |
ed3ef339 DE |
759 | "\ |
760 | Return the address class of the symbol." }, | |
761 | ||
72e02483 PA |
762 | { "symbol-needs-frame?", 1, 0, 0, |
763 | as_a_scm_t_subr (gdbscm_symbol_needs_frame_p), | |
ed3ef339 DE |
764 | "\ |
765 | Return #t if the symbol needs a frame to compute its value." }, | |
766 | ||
72e02483 | 767 | { "symbol-argument?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_argument_p), |
ed3ef339 DE |
768 | "\ |
769 | Return #t if the symbol is a function argument." }, | |
770 | ||
72e02483 | 771 | { "symbol-constant?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_constant_p), |
ed3ef339 DE |
772 | "\ |
773 | Return #t if the symbol is a constant." }, | |
774 | ||
72e02483 | 775 | { "symbol-function?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_function_p), |
ed3ef339 DE |
776 | "\ |
777 | Return #t if the symbol is a function." }, | |
778 | ||
72e02483 | 779 | { "symbol-variable?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_variable_p), |
ed3ef339 DE |
780 | "\ |
781 | Return #t if the symbol is a variable." }, | |
782 | ||
72e02483 | 783 | { "symbol-value", 1, 0, 1, as_a_scm_t_subr (gdbscm_symbol_value), |
ed3ef339 DE |
784 | "\ |
785 | Return the value of the symbol.\n\ | |
786 | \n\ | |
787 | Arguments: <gdb:symbol> [#:frame frame]" }, | |
788 | ||
72e02483 | 789 | { "lookup-symbol", 1, 0, 1, as_a_scm_t_subr (gdbscm_lookup_symbol), |
ed3ef339 DE |
790 | "\ |
791 | Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\ | |
792 | \n\ | |
793 | Arguments: name [#:block block] [#:domain domain]\n\ | |
794 | name: a string containing the name of the symbol to lookup\n\ | |
795 | block: a <gdb:block> object\n\ | |
796 | domain: a SYMBOL_*_DOMAIN value" }, | |
797 | ||
72e02483 PA |
798 | { "lookup-global-symbol", 1, 0, 1, |
799 | as_a_scm_t_subr (gdbscm_lookup_global_symbol), | |
ed3ef339 DE |
800 | "\ |
801 | Return <gdb:symbol> if found, otherwise #f.\n\ | |
802 | \n\ | |
803 | Arguments: name [#:domain domain]\n\ | |
804 | name: a string containing the name of the symbol to lookup\n\ | |
805 | domain: a SYMBOL_*_DOMAIN value" }, | |
806 | ||
807 | END_FUNCTIONS | |
808 | }; | |
809 | ||
810 | void | |
811 | gdbscm_initialize_symbols (void) | |
812 | { | |
813 | symbol_smob_tag | |
814 | = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob)); | |
ed3ef339 DE |
815 | scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob); |
816 | scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob); | |
817 | ||
818 | gdbscm_define_integer_constants (symbol_integer_constants, 1); | |
819 | gdbscm_define_functions (symbol_functions, 1); | |
820 | ||
821 | block_keyword = scm_from_latin1_keyword ("block"); | |
822 | domain_keyword = scm_from_latin1_keyword ("domain"); | |
823 | frame_keyword = scm_from_latin1_keyword ("frame"); | |
824 | ||
825 | /* Register an objfile "free" callback so we can properly | |
826 | invalidate symbols when an object file is about to be deleted. */ | |
827 | syscm_objfile_data_key | |
828 | = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols); | |
1994afbf DE |
829 | |
830 | /* Arch-specific symbol data. */ | |
831 | syscm_gdbarch_data_key | |
832 | = gdbarch_data_register_post_init (syscm_init_arch_symbols); | |
ed3ef339 | 833 | } |