guile: Allow compilation with Guile <= 2.0.5.
[platform/upstream/binutils.git] / gdb / guile / guile-internal.h
1 /* Internal header for GDB/Scheme code.
2
3    Copyright (C) 2014 Free Software Foundation, Inc.
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 #ifndef GDB_GUILE_INTERNAL_H
24 #define GDB_GUILE_INTERNAL_H
25
26 #include "hashtab.h"
27 #include "extension-priv.h"
28 #include "symtab.h"
29 #include "libguile.h"
30
31 struct block;
32 struct frame_info;
33 struct objfile;
34 struct symbol;
35
36 /* A function to pass to the safe-call routines to ignore things like
37    memory errors.  */
38 typedef int excp_matcher_func (SCM key);
39
40 /* Scheme variables to define during initialization.  */
41
42 typedef struct
43 {
44   const char *name;
45   SCM value;
46   const char *doc_string;
47 } scheme_variable;
48
49 /* End of scheme_variable table mark.  */
50
51 #define END_VARIABLES { NULL, SCM_BOOL_F, NULL }
52
53 /* Scheme functions to define during initialization.  */
54
55 typedef struct
56 {
57   const char *name;
58   int required;
59   int optional;
60   int rest;
61   scm_t_subr func;
62   const char *doc_string;
63 } scheme_function;
64
65 /* End of scheme_function table mark.  */
66
67 #define END_FUNCTIONS { NULL, 0, 0, 0, NULL, NULL }
68
69 /* Useful for defining a set of constants.  */
70
71 typedef struct
72 {
73   const char *name;
74   int value;
75 } scheme_integer_constant;
76
77 #define END_INTEGER_CONSTANTS { NULL, 0 }
78
79 /* Pass this instead of 0 to routines like SCM_ASSERT to indicate the value
80    is not a function argument.  */
81 #define GDBSCM_ARG_NONE 0
82
83 /* Ensure new code doesn't accidentally try to use this.  */
84 #undef scm_make_smob_type
85 #define scm_make_smob_type USE_gdbscm_make_smob_type_INSTEAD
86
87 /* They brought over () == #f from lisp.
88    Let's avoid that for now.  */
89 #undef scm_is_bool
90 #undef scm_is_false
91 #undef scm_is_true
92 #define scm_is_bool USE_gdbscm_is_bool_INSTEAD
93 #define scm_is_false USE_gdbscm_is_false_INSTEAD
94 #define scm_is_true USE_gdbscm_is_true_INSTEAD
95 #define gdbscm_is_bool(scm) \
96   (scm_is_eq ((scm), SCM_BOOL_F) || scm_is_eq ((scm), SCM_BOOL_T))
97 #define gdbscm_is_false(scm) scm_is_eq ((scm), SCM_BOOL_F)
98 #define gdbscm_is_true(scm) (!gdbscm_is_false (scm))
99
100 #ifndef HAVE_SCM_NEW_SMOB
101
102 /* Guile <= 2.0.5 did not provide this function, so provide it here.  */
103
104 static inline SCM
105 scm_new_smob (scm_t_bits tc, scm_t_bits data)
106 {
107   SCM_RETURN_NEWSMOB (tc, data);
108 }
109
110 #endif
111
112 /* Function name that is passed around in case an error needs to be reported.
113    __func is in C99, but we provide a wrapper "just in case",
114    and because FUNC_NAME is the canonical value used in guile sources.
115    IWBN to use the Scheme version of the name (e.g. foo-bar vs foo_bar),
116    but let's KISS for now.  */
117 #define FUNC_NAME __func__
118
119 extern const char gdbscm_module_name[];
120 extern const char gdbscm_init_module_name[];
121
122 extern int gdb_scheme_initialized;
123
124 extern const char gdbscm_print_excp_none[];
125 extern const char gdbscm_print_excp_full[];
126 extern const char gdbscm_print_excp_message[];
127 extern const char *gdbscm_print_excp;
128
129 extern SCM gdbscm_documentation_symbol;
130 extern SCM gdbscm_invalid_object_error_symbol;
131
132 extern SCM gdbscm_map_string;
133 extern SCM gdbscm_array_string;
134 extern SCM gdbscm_string_string;
135 \f
136 /* scm-utils.c */
137
138 extern void gdbscm_define_variables (const scheme_variable *, int public);
139
140 extern void gdbscm_define_functions (const scheme_function *, int public);
141
142 extern void gdbscm_define_integer_constants (const scheme_integer_constant *,
143                                              int public);
144
145 extern void gdbscm_printf (SCM port, const char *format, ...);
146
147 extern void gdbscm_debug_display (SCM obj);
148
149 extern void gdbscm_debug_write (SCM obj);
150
151 extern void gdbscm_parse_function_args (const char *function_name,
152                                         int beginning_arg_pos,
153                                         const SCM *keywords,
154                                         const char *format, ...);
155
156 extern SCM gdbscm_scm_from_longest (LONGEST l);
157
158 extern LONGEST gdbscm_scm_to_longest (SCM l);
159
160 extern SCM gdbscm_scm_from_ulongest (ULONGEST l);
161
162 extern ULONGEST gdbscm_scm_to_ulongest (SCM u);
163
164 extern void gdbscm_dynwind_xfree (void *ptr);
165
166 extern int gdbscm_is_procedure (SCM proc);
167 \f
168 /* GDB smobs, from scm-gsmob.c */
169
170 /* All gdb smobs must contain one of the following as the first member:
171    gdb_smob, chained_gdb_smob, or eqable_gdb_smob.
172
173    Chained GDB smobs should have chained_gdb_smob as their first member.  The
174    next,prev members of chained_gdb_smob allow for chaining gsmobs together so
175    that, for example, when an objfile is deleted we can clean up all smobs that
176    reference it.
177
178    Eq-able GDB smobs should have eqable_gdb_smob as their first member.  The
179    containing_scm member of eqable_gdb_smob allows for returning the same gsmob
180    instead of creating a new one, allowing them to be eq?-able.
181
182    All other smobs should have gdb_smob as their first member.
183    FIXME: dje/2014-05-26: gdb_smob was useful during early development as a
184    "baseclass" for all gdb smobs.  If it's still unused by gdb 8.0 delete it.
185
186    IMPORTANT: chained_gdb_smob and eqable_gdb-smob are "subclasses" of
187    gdb_smob.  The layout of chained_gdb_smob,eqable_gdb_smob must match
188    gdb_smob as if it is a subclass.  To that end we use macro GDB_SMOB_HEAD
189    to ensure this.  */
190
191 #define GDB_SMOB_HEAD \
192   int empty_base_class;
193
194 typedef struct
195 {
196   GDB_SMOB_HEAD
197 } gdb_smob;
198
199 typedef struct _chained_gdb_smob
200 {
201   GDB_SMOB_HEAD
202
203   struct _chained_gdb_smob *prev;
204   struct _chained_gdb_smob *next;
205 } chained_gdb_smob;
206
207 typedef struct _eqable_gdb_smob
208 {
209   GDB_SMOB_HEAD
210
211   /* The object we are contained in.
212      This can be used for several purposes.
213      This is used by the eq? machinery:  We need to be able to see if we have
214      already created an object for a symbol, and if so use that SCM.
215      This may also be used to protect the smob from GC if there is
216      a reference to this smob from outside of GC space (i.e., from gdb).
217      This can also be used in place of chained_gdb_smob where we need to
218      keep track of objfile referencing objects.  When the objfile is deleted
219      we need to invalidate the objects: we can do that using the same hashtab
220      used to record the smob for eq-ability.  */
221   SCM containing_scm;
222 } eqable_gdb_smob;
223
224 #undef GDB_SMOB_HEAD
225
226 struct objfile;
227 struct objfile_data;
228
229 /* A predicate that returns non-zero if an object is a particular kind
230    of gsmob.  */
231 typedef int (gsmob_pred_func) (SCM);
232
233 extern scm_t_bits gdbscm_make_smob_type (const char *name, size_t size);
234
235 extern void gdbscm_init_gsmob (gdb_smob *base);
236
237 extern void gdbscm_init_chained_gsmob (chained_gdb_smob *base);
238
239 extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob *base,
240                                       SCM containing_scm);
241
242 extern void gdbscm_add_objfile_ref (struct objfile *objfile,
243                                     const struct objfile_data *data_key,
244                                     chained_gdb_smob *g_smob);
245
246 extern void gdbscm_remove_objfile_ref (struct objfile *objfile,
247                                        const struct objfile_data *data_key,
248                                        chained_gdb_smob *g_smob);
249
250 extern htab_t gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn,
251                                                   htab_eq eq_fn);
252
253 extern eqable_gdb_smob **gdbscm_find_eqable_gsmob_ptr_slot
254   (htab_t htab, eqable_gdb_smob *base);
255
256 extern void gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob **slot,
257                                                eqable_gdb_smob *base);
258
259 extern void gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab,
260                                                 eqable_gdb_smob *base);
261 \f
262 /* Exceptions and calling out to Guile.  */
263
264 /* scm-exception.c */
265
266 extern SCM gdbscm_make_exception (SCM tag, SCM args);
267
268 extern int gdbscm_is_exception (SCM scm);
269
270 extern SCM gdbscm_exception_key (SCM excp);
271
272 extern SCM gdbscm_exception_args (SCM excp);
273
274 extern SCM gdbscm_make_exception_with_stack (SCM key, SCM args, SCM stack);
275
276 extern SCM gdbscm_make_error_scm (SCM key, SCM subr, SCM message,
277                                   SCM args, SCM data);
278
279 extern SCM gdbscm_make_error (SCM key, const char *subr, const char *message,
280                               SCM args, SCM data);
281
282 extern SCM gdbscm_make_type_error (const char *subr, int arg_pos,
283                                    SCM bad_value, const char *expected_type);
284
285 extern SCM gdbscm_make_invalid_object_error (const char *subr, int arg_pos,
286                                              SCM bad_value, const char *error);
287
288 extern void gdbscm_invalid_object_error (const char *subr, int arg_pos,
289                                          SCM bad_value, const char *error)
290    ATTRIBUTE_NORETURN;
291
292 extern SCM gdbscm_make_out_of_range_error (const char *subr, int arg_pos,
293                                            SCM bad_value, const char *error);
294
295 extern void gdbscm_out_of_range_error (const char *subr, int arg_pos,
296                                        SCM bad_value, const char *error)
297    ATTRIBUTE_NORETURN;
298
299 extern SCM gdbscm_make_misc_error (const char *subr, int arg_pos,
300                                    SCM bad_value, const char *error);
301
302 extern void gdbscm_throw (SCM exception) ATTRIBUTE_NORETURN;
303
304 extern SCM gdbscm_scm_from_gdb_exception (struct gdb_exception exception);
305
306 extern void gdbscm_throw_gdb_exception (struct gdb_exception exception)
307   ATTRIBUTE_NORETURN;
308
309 extern void gdbscm_print_exception_with_stack (SCM port, SCM stack,
310                                                SCM key, SCM args);
311
312 extern void gdbscm_print_gdb_exception (SCM port, SCM exception);
313
314 extern char *gdbscm_exception_message_to_string (SCM exception);
315
316 extern excp_matcher_func gdbscm_memory_error_p;
317
318 extern SCM gdbscm_make_memory_error (const char *subr, const char *msg,
319                                      SCM args);
320
321 extern void gdbscm_memory_error (const char *subr, const char *msg, SCM args)
322   ATTRIBUTE_NORETURN;
323
324 /* scm-safe-call.c */
325
326 extern void *gdbscm_with_guile (void *(*func) (void *), void *data);
327
328 extern SCM gdbscm_call_guile (SCM (*func) (void *), void *data,
329                               excp_matcher_func *ok_excps);
330
331 extern SCM gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps);
332
333 extern SCM gdbscm_safe_call_1 (SCM proc, SCM arg0,
334                                excp_matcher_func *ok_excps);
335
336 extern SCM gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1,
337                                excp_matcher_func *ok_excps);
338
339 extern SCM gdbscm_safe_call_3 (SCM proc, SCM arg0, SCM arg1, SCM arg2,
340                                excp_matcher_func *ok_excps);
341
342 extern SCM gdbscm_safe_call_4 (SCM proc, SCM arg0, SCM arg1, SCM arg2,
343                                SCM arg3,
344                                excp_matcher_func *ok_excps);
345
346 extern SCM gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM args,
347                                 excp_matcher_func *ok_excps);
348
349 extern SCM gdbscm_unsafe_call_1 (SCM proc, SCM arg0);
350
351 extern char *gdbscm_safe_eval_string (const char *string, int display_result);
352
353 extern char *gdbscm_safe_source_script (const char *filename);
354
355 extern void gdbscm_enter_repl (void);
356 \f
357 /* Interface to various GDB objects, in alphabetical order.  */
358
359 /* scm-arch.c */
360
361 typedef struct _arch_smob arch_smob;
362
363 extern struct gdbarch *arscm_get_gdbarch (arch_smob *a_smob);
364
365 extern arch_smob *arscm_get_arch_smob_arg_unsafe (SCM arch_scm, int arg_pos,
366                                                   const char *func_name);
367
368 extern SCM arscm_scm_from_arch (struct gdbarch *gdbarch);
369
370 /* scm-block.c */
371
372 extern SCM bkscm_scm_from_block (const struct block *block,
373                                  struct objfile *objfile);
374
375 extern const struct block *bkscm_scm_to_block
376   (SCM block_scm, int arg_pos, const char *func_name, SCM *excp);
377
378 /* scm-frame.c */
379
380 typedef struct _frame_smob frame_smob;
381
382 extern int frscm_is_frame (SCM scm);
383
384 extern frame_smob *frscm_get_frame_smob_arg_unsafe (SCM frame_scm, int arg_pos,
385                                                     const char *func_name);
386
387 extern struct frame_info *frscm_frame_smob_to_frame (frame_smob *);
388
389 /* scm-iterator.c */
390
391 typedef struct _iterator_smob iterator_smob;
392
393 extern SCM itscm_iterator_smob_object (iterator_smob *i_smob);
394
395 extern SCM itscm_iterator_smob_progress (iterator_smob *i_smob);
396
397 extern void itscm_set_iterator_smob_progress_x (iterator_smob *i_smob,
398                                                 SCM progress);
399
400 extern const char *itscm_iterator_smob_name (void);
401
402 extern SCM gdbscm_make_iterator (SCM object, SCM progress, SCM next);
403
404 extern int itscm_is_iterator (SCM scm);
405
406 extern SCM gdbscm_end_of_iteration (void);
407
408 extern int itscm_is_end_of_iteration (SCM obj);
409
410 extern SCM itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps);
411
412 extern SCM itscm_get_iterator_arg_unsafe (SCM self, int arg_pos,
413                                           const char *func_name);
414
415 /* scm-lazy-string.c */
416
417 extern int lsscm_is_lazy_string (SCM scm);
418
419 extern SCM lsscm_make_lazy_string (CORE_ADDR address, int length,
420                                    const char *encoding, struct type *type);
421
422 extern struct value *lsscm_safe_lazy_string_to_value (SCM string,
423                                                       int arg_pos,
424                                                       const char *func_name,
425                                                       SCM *except_scmp);
426
427 extern void lsscm_val_print_lazy_string
428   (SCM string, struct ui_file *stream,
429    const struct value_print_options *options);
430
431 /* scm-objfile.c */
432
433 typedef struct _objfile_smob objfile_smob;
434
435 extern SCM ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob);
436
437 extern objfile_smob *ofscm_objfile_smob_from_objfile (struct objfile *objfile);
438
439 extern SCM ofscm_scm_from_objfile (struct objfile *objfile);
440
441 /* scm-string.c */
442
443 extern char *gdbscm_scm_to_c_string (SCM string);
444
445 extern SCM gdbscm_scm_from_c_string (const char *string);
446
447 extern SCM gdbscm_scm_from_printf (const char *format, ...);
448
449 extern char *gdbscm_scm_to_string (SCM string, size_t *lenp,
450                                    const char *charset,
451                                    int strict, SCM *except_scmp);
452
453 extern SCM gdbscm_scm_from_string (const char *string, size_t len,
454                                    const char *charset, int strict);
455
456 /* scm-symbol.c */
457
458 extern int syscm_is_symbol (SCM scm);
459
460 extern SCM syscm_scm_from_symbol (struct symbol *symbol);
461
462 extern struct symbol *syscm_get_valid_symbol_arg_unsafe
463   (SCM self, int arg_pos, const char *func_name);
464
465 /* scm-symtab.c */
466
467 extern SCM stscm_scm_from_symtab (struct symtab *symtab);
468
469 extern SCM stscm_scm_from_sal (struct symtab_and_line sal);
470
471 /* scm-type.c */
472
473 typedef struct _type_smob type_smob;
474
475 extern int tyscm_is_type (SCM scm);
476
477 extern SCM tyscm_scm_from_type (struct type *type);
478
479 extern type_smob *tyscm_get_type_smob_arg_unsafe (SCM type_scm, int arg_pos,
480                                                   const char *func_name);
481
482 extern struct type *tyscm_type_smob_type (type_smob *t_smob);
483
484 extern SCM tyscm_scm_from_field (SCM type_scm, int field_num);
485
486 /* scm-value.c */
487
488 extern struct value *vlscm_scm_to_value (SCM scm);
489
490 extern int vlscm_is_value (SCM scm);
491
492 extern SCM vlscm_scm_from_value (struct value *value);
493
494 extern SCM vlscm_scm_from_value_unsafe (struct value *value);
495
496 extern struct value *vlscm_convert_typed_value_from_scheme
497   (const char *func_name, int obj_arg_pos, SCM obj,
498    int type_arg_pos, SCM type_scm, struct type *type, SCM *except_scmp,
499    struct gdbarch *gdbarch, const struct language_defn *language);
500
501 extern struct value *vlscm_convert_value_from_scheme
502   (const char *func_name, int obj_arg_pos, SCM obj, SCM *except_scmp,
503    struct gdbarch *gdbarch, const struct language_defn *language);
504 \f
505 /* stript_lang methods */
506
507 extern objfile_script_sourcer_func gdbscm_source_objfile_script;
508
509 extern int gdbscm_auto_load_enabled (const struct extension_language_defn *);
510
511 extern void gdbscm_preserve_values
512   (const struct extension_language_defn *,
513    struct objfile *, htab_t copied_types);
514
515 extern enum ext_lang_rc gdbscm_apply_val_pretty_printer
516   (const struct extension_language_defn *,
517    struct type *type, const gdb_byte *valaddr,
518    int embedded_offset, CORE_ADDR address,
519    struct ui_file *stream, int recurse,
520    const struct value *val,
521    const struct value_print_options *options,
522    const struct language_defn *language);
523
524 extern int gdbscm_breakpoint_has_cond (const struct extension_language_defn *,
525                                        struct breakpoint *b);
526
527 extern enum ext_lang_bp_stop gdbscm_breakpoint_cond_says_stop
528   (const struct extension_language_defn *, struct breakpoint *b);
529 \f
530 /* Initializers for each piece of Scheme support, in alphabetical order.  */
531
532 extern void gdbscm_initialize_arches (void);
533 extern void gdbscm_initialize_auto_load (void);
534 extern void gdbscm_initialize_blocks (void);
535 extern void gdbscm_initialize_breakpoints (void);
536 extern void gdbscm_initialize_disasm (void);
537 extern void gdbscm_initialize_exceptions (void);
538 extern void gdbscm_initialize_frames (void);
539 extern void gdbscm_initialize_iterators (void);
540 extern void gdbscm_initialize_lazy_strings (void);
541 extern void gdbscm_initialize_math (void);
542 extern void gdbscm_initialize_objfiles (void);
543 extern void gdbscm_initialize_pretty_printers (void);
544 extern void gdbscm_initialize_ports (void);
545 extern void gdbscm_initialize_smobs (void);
546 extern void gdbscm_initialize_strings (void);
547 extern void gdbscm_initialize_symbols (void);
548 extern void gdbscm_initialize_symtabs (void);
549 extern void gdbscm_initialize_types (void);
550 extern void gdbscm_initialize_values (void);
551 \f
552 /* Use these after a TRY_CATCH to throw the appropriate Scheme exception
553    if a GDB error occurred.  */
554
555 #define GDBSCM_HANDLE_GDB_EXCEPTION(exception)          \
556   do {                                                  \
557     if (exception.reason < 0)                           \
558       {                                                 \
559         gdbscm_throw_gdb_exception (exception);         \
560         /*NOTREACHED */                                 \
561       }                                                 \
562   } while (0)
563
564 /* If cleanups are establish outside the TRY_CATCH block, use this version.  */
565
566 #define GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS(exception, cleanups)  \
567   do {                                                                  \
568     if (exception.reason < 0)                                           \
569       {                                                                 \
570         do_cleanups (cleanups);                                         \
571         gdbscm_throw_gdb_exception (exception);                         \
572         /*NOTREACHED */                                                 \
573       }                                                                 \
574   } while (0)
575
576 #endif /* GDB_GUILE_INTERNAL_H */