1 /* Scheme interface to architecture.
3 Copyright (C) 2014 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
26 #include "arch-utils.h"
27 #include "guile-internal.h"
29 /* The <gdb:arch> smob.
30 The typedef for this struct is in guile-internal.h. */
34 /* This always appears first. */
37 struct gdbarch
*gdbarch
;
40 static const char arch_smob_name
[] = "gdb:arch";
42 /* The tag Guile knows the arch smob by. */
43 static scm_t_bits arch_smob_tag
;
45 static struct gdbarch_data
*arch_object_data
= NULL
;
47 static int arscm_is_arch (SCM
);
49 /* Administrivia for arch smobs. */
51 /* The smob "print" function for <gdb:arch>. */
54 arscm_print_arch_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
56 arch_smob
*a_smob
= (arch_smob
*) SCM_SMOB_DATA (self
);
57 struct gdbarch
*gdbarch
= a_smob
->gdbarch
;
59 gdbscm_printf (port
, "#<%s", arch_smob_name
);
60 gdbscm_printf (port
, " %s", gdbarch_bfd_arch_info (gdbarch
)->printable_name
);
63 scm_remember_upto_here_1 (self
);
65 /* Non-zero means success. */
69 /* Low level routine to create a <gdb:arch> object for GDBARCH. */
72 arscm_make_arch_smob (struct gdbarch
*gdbarch
)
74 arch_smob
*a_smob
= (arch_smob
*)
75 scm_gc_malloc (sizeof (arch_smob
), arch_smob_name
);
78 a_smob
->gdbarch
= gdbarch
;
79 a_scm
= scm_new_smob (arch_smob_tag
, (scm_t_bits
) a_smob
);
80 gdbscm_init_gsmob (&a_smob
->base
);
85 /* Return the gdbarch field of A_SMOB. */
88 arscm_get_gdbarch (arch_smob
*a_smob
)
90 return a_smob
->gdbarch
;
93 /* Return non-zero if SCM is an architecture smob. */
96 arscm_is_arch (SCM scm
)
98 return SCM_SMOB_PREDICATE (arch_smob_tag
, scm
);
101 /* (arch? object) -> boolean */
104 gdbscm_arch_p (SCM scm
)
106 return scm_from_bool (arscm_is_arch (scm
));
109 /* Associates an arch_object with GDBARCH as gdbarch_data via the gdbarch
110 post init registration mechanism (gdbarch_data_register_post_init). */
113 arscm_object_data_init (struct gdbarch
*gdbarch
)
115 SCM arch_scm
= arscm_make_arch_smob (gdbarch
);
117 /* This object lasts the duration of the GDB session, so there is no
118 call to scm_gc_unprotect_object for it. */
119 scm_gc_protect_object (arch_scm
);
121 return (void *) arch_scm
;
124 /* Return the <gdb:arch> object corresponding to GDBARCH.
125 The object is cached in GDBARCH so this is simple. */
128 arscm_scm_from_arch (struct gdbarch
*gdbarch
)
130 SCM a_scm
= (SCM
) gdbarch_data (gdbarch
, arch_object_data
);
135 /* Return the <gdb:arch> smob in SELF.
136 Throws an exception if SELF is not a <gdb:arch> object. */
139 arscm_get_arch_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
141 SCM_ASSERT_TYPE (arscm_is_arch (self
), self
, arg_pos
, func_name
,
147 /* Return a pointer to the arch smob of SELF.
148 Throws an exception if SELF is not a <gdb:arch> object. */
151 arscm_get_arch_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
153 SCM a_scm
= arscm_get_arch_arg_unsafe (self
, arg_pos
, func_name
);
154 arch_smob
*a_smob
= (arch_smob
*) SCM_SMOB_DATA (a_scm
);
161 /* (current-arch) -> <gdb:arch>
162 Return the architecture of the currently selected stack frame,
163 if there is one, or the current target if there isn't. */
166 gdbscm_current_arch (void)
168 return arscm_scm_from_arch (get_current_arch ());
171 /* (arch-name <gdb:arch>) -> string
172 Return the name of the architecture as a string value. */
175 gdbscm_arch_name (SCM self
)
178 = arscm_get_arch_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
179 struct gdbarch
*gdbarch
= a_smob
->gdbarch
;
182 name
= (gdbarch_bfd_arch_info (gdbarch
))->printable_name
;
184 return gdbscm_scm_from_c_string (name
);
187 /* (arch-charset <gdb:arch>) -> string */
190 gdbscm_arch_charset (SCM self
)
193 =arscm_get_arch_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
194 struct gdbarch
*gdbarch
= a_smob
->gdbarch
;
196 return gdbscm_scm_from_c_string (target_charset (gdbarch
));
199 /* (arch-wide-charset <gdb:arch>) -> string */
202 gdbscm_arch_wide_charset (SCM self
)
205 = arscm_get_arch_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
206 struct gdbarch
*gdbarch
= a_smob
->gdbarch
;
208 return gdbscm_scm_from_c_string (target_wide_charset (gdbarch
));
213 The order the types are defined here follows the order in
214 struct builtin_type. */
216 /* Helper routine to return a builtin type for <gdb:arch> object SELF.
217 OFFSET is offsetof (builtin_type, the_type).
218 Throws an exception if SELF is not a <gdb:arch> object. */
220 static const struct builtin_type
*
221 gdbscm_arch_builtin_type (SCM self
, const char *func_name
)
224 = arscm_get_arch_smob_arg_unsafe (self
, SCM_ARG1
, func_name
);
225 struct gdbarch
*gdbarch
= a_smob
->gdbarch
;
227 return builtin_type (gdbarch
);
230 /* (arch-void-type <gdb:arch>) -> <gdb:type> */
233 gdbscm_arch_void_type (SCM self
)
236 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_void
;
238 return tyscm_scm_from_type (type
);
241 /* (arch-char-type <gdb:arch>) -> <gdb:type> */
244 gdbscm_arch_char_type (SCM self
)
247 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_char
;
249 return tyscm_scm_from_type (type
);
252 /* (arch-short-type <gdb:arch>) -> <gdb:type> */
255 gdbscm_arch_short_type (SCM self
)
258 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_short
;
260 return tyscm_scm_from_type (type
);
263 /* (arch-int-type <gdb:arch>) -> <gdb:type> */
266 gdbscm_arch_int_type (SCM self
)
269 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_int
;
271 return tyscm_scm_from_type (type
);
274 /* (arch-long-type <gdb:arch>) -> <gdb:type> */
277 gdbscm_arch_long_type (SCM self
)
280 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_long
;
282 return tyscm_scm_from_type (type
);
285 /* (arch-schar-type <gdb:arch>) -> <gdb:type> */
288 gdbscm_arch_schar_type (SCM self
)
291 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_signed_char
;
293 return tyscm_scm_from_type (type
);
296 /* (arch-uchar-type <gdb:arch>) -> <gdb:type> */
299 gdbscm_arch_uchar_type (SCM self
)
302 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_unsigned_char
;
304 return tyscm_scm_from_type (type
);
307 /* (arch-ushort-type <gdb:arch>) -> <gdb:type> */
310 gdbscm_arch_ushort_type (SCM self
)
313 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_unsigned_short
;
315 return tyscm_scm_from_type (type
);
318 /* (arch-uint-type <gdb:arch>) -> <gdb:type> */
321 gdbscm_arch_uint_type (SCM self
)
324 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_unsigned_int
;
326 return tyscm_scm_from_type (type
);
329 /* (arch-ulong-type <gdb:arch>) -> <gdb:type> */
332 gdbscm_arch_ulong_type (SCM self
)
335 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_unsigned_long
;
337 return tyscm_scm_from_type (type
);
340 /* (arch-float-type <gdb:arch>) -> <gdb:type> */
343 gdbscm_arch_float_type (SCM self
)
346 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_float
;
348 return tyscm_scm_from_type (type
);
351 /* (arch-double-type <gdb:arch>) -> <gdb:type> */
354 gdbscm_arch_double_type (SCM self
)
357 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_double
;
359 return tyscm_scm_from_type (type
);
362 /* (arch-longdouble-type <gdb:arch>) -> <gdb:type> */
365 gdbscm_arch_longdouble_type (SCM self
)
368 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_long_double
;
370 return tyscm_scm_from_type (type
);
373 /* (arch-bool-type <gdb:arch>) -> <gdb:type> */
376 gdbscm_arch_bool_type (SCM self
)
379 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_bool
;
381 return tyscm_scm_from_type (type
);
384 /* (arch-longlong-type <gdb:arch>) -> <gdb:type> */
387 gdbscm_arch_longlong_type (SCM self
)
390 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_long_long
;
392 return tyscm_scm_from_type (type
);
395 /* (arch-ulonglong-type <gdb:arch>) -> <gdb:type> */
398 gdbscm_arch_ulonglong_type (SCM self
)
401 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_unsigned_long_long
;
403 return tyscm_scm_from_type (type
);
406 /* (arch-int8-type <gdb:arch>) -> <gdb:type> */
409 gdbscm_arch_int8_type (SCM self
)
412 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_int8
;
414 return tyscm_scm_from_type (type
);
417 /* (arch-uint8-type <gdb:arch>) -> <gdb:type> */
420 gdbscm_arch_uint8_type (SCM self
)
423 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_uint8
;
425 return tyscm_scm_from_type (type
);
428 /* (arch-int16-type <gdb:arch>) -> <gdb:type> */
431 gdbscm_arch_int16_type (SCM self
)
434 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_int16
;
436 return tyscm_scm_from_type (type
);
439 /* (arch-uint16-type <gdb:arch>) -> <gdb:type> */
442 gdbscm_arch_uint16_type (SCM self
)
445 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_uint16
;
447 return tyscm_scm_from_type (type
);
450 /* (arch-int32-type <gdb:arch>) -> <gdb:type> */
453 gdbscm_arch_int32_type (SCM self
)
456 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_int32
;
458 return tyscm_scm_from_type (type
);
461 /* (arch-uint32-type <gdb:arch>) -> <gdb:type> */
464 gdbscm_arch_uint32_type (SCM self
)
467 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_uint32
;
469 return tyscm_scm_from_type (type
);
472 /* (arch-int64-type <gdb:arch>) -> <gdb:type> */
475 gdbscm_arch_int64_type (SCM self
)
478 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_int64
;
480 return tyscm_scm_from_type (type
);
483 /* (arch-uint64-type <gdb:arch>) -> <gdb:type> */
486 gdbscm_arch_uint64_type (SCM self
)
489 = gdbscm_arch_builtin_type (self
, FUNC_NAME
)->builtin_uint64
;
491 return tyscm_scm_from_type (type
);
494 /* Initialize the Scheme architecture support. */
496 static const scheme_function arch_functions
[] =
498 { "arch?", 1, 0, 0, gdbscm_arch_p
,
500 Return #t if the object is a <gdb:arch> object." },
502 { "current-arch", 0, 0, 0, gdbscm_current_arch
,
504 Return the <gdb:arch> object representing the architecture of the\n\
505 currently selected stack frame, if there is one, or the architecture of the\n\
506 current target if there isn't.\n\
510 { "arch-name", 1, 0, 0, gdbscm_arch_name
,
512 Return the name of the architecture." },
514 { "arch-charset", 1, 0, 0, gdbscm_arch_charset
,
516 Return name of target character set as a string." },
518 { "arch-wide-charset", 1, 0, 0, gdbscm_arch_wide_charset
,
520 Return name of target wide character set as a string." },
522 { "arch-void-type", 1, 0, 0, gdbscm_arch_void_type
,
524 Return the <gdb:type> object for the \"void\" type\n\
525 of the architecture." },
527 { "arch-char-type", 1, 0, 0, gdbscm_arch_char_type
,
529 Return the <gdb:type> object for the \"char\" type\n\
530 of the architecture." },
532 { "arch-short-type", 1, 0, 0, gdbscm_arch_short_type
,
534 Return the <gdb:type> object for the \"short\" type\n\
535 of the architecture." },
537 { "arch-int-type", 1, 0, 0, gdbscm_arch_int_type
,
539 Return the <gdb:type> object for the \"int\" type\n\
540 of the architecture." },
542 { "arch-long-type", 1, 0, 0, gdbscm_arch_long_type
,
544 Return the <gdb:type> object for the \"long\" type\n\
545 of the architecture." },
547 { "arch-schar-type", 1, 0, 0, gdbscm_arch_schar_type
,
549 Return the <gdb:type> object for the \"signed char\" type\n\
550 of the architecture." },
552 { "arch-uchar-type", 1, 0, 0, gdbscm_arch_uchar_type
,
554 Return the <gdb:type> object for the \"unsigned char\" type\n\
555 of the architecture." },
557 { "arch-ushort-type", 1, 0, 0, gdbscm_arch_ushort_type
,
559 Return the <gdb:type> object for the \"unsigned short\" type\n\
560 of the architecture." },
562 { "arch-uint-type", 1, 0, 0, gdbscm_arch_uint_type
,
564 Return the <gdb:type> object for the \"unsigned int\" type\n\
565 of the architecture." },
567 { "arch-ulong-type", 1, 0, 0, gdbscm_arch_ulong_type
,
569 Return the <gdb:type> object for the \"unsigned long\" type\n\
570 of the architecture." },
572 { "arch-float-type", 1, 0, 0, gdbscm_arch_float_type
,
574 Return the <gdb:type> object for the \"float\" type\n\
575 of the architecture." },
577 { "arch-double-type", 1, 0, 0, gdbscm_arch_double_type
,
579 Return the <gdb:type> object for the \"double\" type\n\
580 of the architecture." },
582 { "arch-longdouble-type", 1, 0, 0, gdbscm_arch_longdouble_type
,
584 Return the <gdb:type> object for the \"long double\" type\n\
585 of the architecture." },
587 { "arch-bool-type", 1, 0, 0, gdbscm_arch_bool_type
,
589 Return the <gdb:type> object for the \"bool\" type\n\
590 of the architecture." },
592 { "arch-longlong-type", 1, 0, 0, gdbscm_arch_longlong_type
,
594 Return the <gdb:type> object for the \"long long\" type\n\
595 of the architecture." },
597 { "arch-ulonglong-type", 1, 0, 0,
598 gdbscm_arch_ulonglong_type
,
600 Return the <gdb:type> object for the \"unsigned long long\" type\n\
601 of the architecture." },
603 { "arch-int8-type", 1, 0, 0, gdbscm_arch_int8_type
,
605 Return the <gdb:type> object for the \"int8\" type\n\
606 of the architecture." },
608 { "arch-uint8-type", 1, 0, 0, gdbscm_arch_uint8_type
,
610 Return the <gdb:type> object for the \"uint8\" type\n\
611 of the architecture." },
613 { "arch-int16-type", 1, 0, 0, gdbscm_arch_int16_type
,
615 Return the <gdb:type> object for the \"int16\" type\n\
616 of the architecture." },
618 { "arch-uint16-type", 1, 0, 0, gdbscm_arch_uint16_type
,
620 Return the <gdb:type> object for the \"uint16\" type\n\
621 of the architecture." },
623 { "arch-int32-type", 1, 0, 0, gdbscm_arch_int32_type
,
625 Return the <gdb:type> object for the \"int32\" type\n\
626 of the architecture." },
628 { "arch-uint32-type", 1, 0, 0, gdbscm_arch_uint32_type
,
630 Return the <gdb:type> object for the \"uint32\" type\n\
631 of the architecture." },
633 { "arch-int64-type", 1, 0, 0, gdbscm_arch_int64_type
,
635 Return the <gdb:type> object for the \"int64\" type\n\
636 of the architecture." },
638 { "arch-uint64-type", 1, 0, 0, gdbscm_arch_uint64_type
,
640 Return the <gdb:type> object for the \"uint64\" type\n\
641 of the architecture." },
647 gdbscm_initialize_arches (void)
649 arch_smob_tag
= gdbscm_make_smob_type (arch_smob_name
, sizeof (arch_smob
));
650 scm_set_smob_print (arch_smob_tag
, arscm_print_arch_smob
);
652 gdbscm_define_functions (arch_functions
, 1);
655 = gdbarch_data_register_post_init (arscm_object_data_init
);