1 /* Scheme interface to architecture. 2 3 Copyright (C) 2014-2024 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 #include "charset.h" 24 #include "gdbarch.h" 25 #include "arch-utils.h" 26 #include "guile-internal.h" 27 28 /* The <gdb:arch> smob. */ 29 30 struct arch_smob 31 { 32 /* This always appears first. */ 33 gdb_smob base; 34 35 struct gdbarch *gdbarch; 36 }; 37 38 static const char arch_smob_name[] = "gdb:arch"; 39 40 /* The tag Guile knows the arch smob by. */ 41 static scm_t_bits arch_smob_tag; 42 43 /* Use a 'void *' here because it isn't guaranteed that SCM is a 44 pointer. */ 45 static const registry<gdbarch>::key<void, gdb::noop_deleter<void>> 46 arch_object_data; 47 48 static int arscm_is_arch (SCM); 49 50 /* Administrivia for arch smobs. */ 52 53 /* The smob "print" function for <gdb:arch>. */ 54 55 static int 56 arscm_print_arch_smob (SCM self, SCM port, scm_print_state *pstate) 57 { 58 arch_smob *a_smob = (arch_smob *) SCM_SMOB_DATA (self); 59 struct gdbarch *gdbarch = a_smob->gdbarch; 60 61 gdbscm_printf (port, "#<%s", arch_smob_name); 62 gdbscm_printf (port, " %s", gdbarch_bfd_arch_info (gdbarch)->printable_name); 63 scm_puts (">", port); 64 65 scm_remember_upto_here_1 (self); 66 67 /* Non-zero means success. */ 68 return 1; 69 } 70 71 /* Low level routine to create a <gdb:arch> object for GDBARCH. */ 72 73 static SCM 74 arscm_make_arch_smob (struct gdbarch *gdbarch) 75 { 76 arch_smob *a_smob = (arch_smob *) 77 scm_gc_malloc (sizeof (arch_smob), arch_smob_name); 78 SCM a_scm; 79 80 a_smob->gdbarch = gdbarch; 81 a_scm = scm_new_smob (arch_smob_tag, (scm_t_bits) a_smob); 82 gdbscm_init_gsmob (&a_smob->base); 83 84 return a_scm; 85 } 86 87 /* Return the gdbarch field of A_SMOB. */ 88 89 struct gdbarch * 90 arscm_get_gdbarch (arch_smob *a_smob) 91 { 92 return a_smob->gdbarch; 93 } 94 95 /* Return non-zero if SCM is an architecture smob. */ 96 97 static int 98 arscm_is_arch (SCM scm) 99 { 100 return SCM_SMOB_PREDICATE (arch_smob_tag, scm); 101 } 102 103 /* (arch? object) -> boolean */ 104 105 static SCM 106 gdbscm_arch_p (SCM scm) 107 { 108 return scm_from_bool (arscm_is_arch (scm)); 109 } 110 111 /* Return the <gdb:arch> object corresponding to GDBARCH. 112 The object is cached in GDBARCH so this is simple. */ 113 114 SCM 115 arscm_scm_from_arch (struct gdbarch *gdbarch) 116 { 117 SCM arch_scm; 118 void *data = arch_object_data.get (gdbarch); 119 if (data == nullptr) 120 { 121 arch_scm = arscm_make_arch_smob (gdbarch); 122 123 /* This object lasts the duration of the GDB session, so there 124 is no call to scm_gc_unprotect_object for it. */ 125 scm_gc_protect_object (arch_scm); 126 127 arch_object_data.set (gdbarch, (void *) arch_scm); 128 } 129 else 130 arch_scm = (SCM) data; 131 132 return arch_scm; 133 } 134 135 /* Return the <gdb:arch> smob in SELF. 136 Throws an exception if SELF is not a <gdb:arch> object. */ 137 138 static SCM 139 arscm_get_arch_arg_unsafe (SCM self, int arg_pos, const char *func_name) 140 { 141 SCM_ASSERT_TYPE (arscm_is_arch (self), self, arg_pos, func_name, 142 arch_smob_name); 143 144 return self; 145 } 146 147 /* Return a pointer to the arch smob of SELF. 148 Throws an exception if SELF is not a <gdb:arch> object. */ 149 150 arch_smob * 151 arscm_get_arch_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) 152 { 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); 155 156 return a_smob; 157 } 158 159 /* Arch methods. */ 161 162 /* (current-arch) -> <gdb:arch> 163 Return the architecture of the currently selected stack frame, 164 if there is one, or the current target if there isn't. */ 165 166 static SCM 167 gdbscm_current_arch (void) 168 { 169 return arscm_scm_from_arch (get_current_arch ()); 170 } 171 172 /* (arch-name <gdb:arch>) -> string 173 Return the name of the architecture as a string value. */ 174 175 static SCM 176 gdbscm_arch_name (SCM self) 177 { 178 arch_smob *a_smob 179 = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 180 struct gdbarch *gdbarch = a_smob->gdbarch; 181 const char *name; 182 183 name = (gdbarch_bfd_arch_info (gdbarch))->printable_name; 184 185 return gdbscm_scm_from_c_string (name); 186 } 187 188 /* (arch-charset <gdb:arch>) -> string */ 189 190 static SCM 191 gdbscm_arch_charset (SCM self) 192 { 193 arch_smob *a_smob 194 =arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 195 struct gdbarch *gdbarch = a_smob->gdbarch; 196 197 return gdbscm_scm_from_c_string (target_charset (gdbarch)); 198 } 199 200 /* (arch-wide-charset <gdb:arch>) -> string */ 201 202 static SCM 203 gdbscm_arch_wide_charset (SCM self) 204 { 205 arch_smob *a_smob 206 = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 207 struct gdbarch *gdbarch = a_smob->gdbarch; 208 209 return gdbscm_scm_from_c_string (target_wide_charset (gdbarch)); 210 } 211 212 /* Builtin types. 214 215 The order the types are defined here follows the order in 216 struct builtin_type. */ 217 218 /* Helper routine to return a builtin type for <gdb:arch> object SELF. 219 OFFSET is offsetof (builtin_type, the_type). 220 Throws an exception if SELF is not a <gdb:arch> object. */ 221 222 static const struct builtin_type * 223 gdbscm_arch_builtin_type (SCM self, const char *func_name) 224 { 225 arch_smob *a_smob 226 = arscm_get_arch_smob_arg_unsafe (self, SCM_ARG1, func_name); 227 struct gdbarch *gdbarch = a_smob->gdbarch; 228 229 return builtin_type (gdbarch); 230 } 231 232 /* (arch-void-type <gdb:arch>) -> <gdb:type> */ 233 234 static SCM 235 gdbscm_arch_void_type (SCM self) 236 { 237 struct type *type 238 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_void; 239 240 return tyscm_scm_from_type (type); 241 } 242 243 /* (arch-char-type <gdb:arch>) -> <gdb:type> */ 244 245 static SCM 246 gdbscm_arch_char_type (SCM self) 247 { 248 struct type *type 249 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_char; 250 251 return tyscm_scm_from_type (type); 252 } 253 254 /* (arch-short-type <gdb:arch>) -> <gdb:type> */ 255 256 static SCM 257 gdbscm_arch_short_type (SCM self) 258 { 259 struct type *type 260 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_short; 261 262 return tyscm_scm_from_type (type); 263 } 264 265 /* (arch-int-type <gdb:arch>) -> <gdb:type> */ 266 267 static SCM 268 gdbscm_arch_int_type (SCM self) 269 { 270 struct type *type 271 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int; 272 273 return tyscm_scm_from_type (type); 274 } 275 276 /* (arch-long-type <gdb:arch>) -> <gdb:type> */ 277 278 static SCM 279 gdbscm_arch_long_type (SCM self) 280 { 281 struct type *type 282 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_long; 283 284 return tyscm_scm_from_type (type); 285 } 286 287 /* (arch-schar-type <gdb:arch>) -> <gdb:type> */ 288 289 static SCM 290 gdbscm_arch_schar_type (SCM self) 291 { 292 struct type *type 293 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_signed_char; 294 295 return tyscm_scm_from_type (type); 296 } 297 298 /* (arch-uchar-type <gdb:arch>) -> <gdb:type> */ 299 300 static SCM 301 gdbscm_arch_uchar_type (SCM self) 302 { 303 struct type *type 304 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_char; 305 306 return tyscm_scm_from_type (type); 307 } 308 309 /* (arch-ushort-type <gdb:arch>) -> <gdb:type> */ 310 311 static SCM 312 gdbscm_arch_ushort_type (SCM self) 313 { 314 struct type *type 315 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_short; 316 317 return tyscm_scm_from_type (type); 318 } 319 320 /* (arch-uint-type <gdb:arch>) -> <gdb:type> */ 321 322 static SCM 323 gdbscm_arch_uint_type (SCM self) 324 { 325 struct type *type 326 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_int; 327 328 return tyscm_scm_from_type (type); 329 } 330 331 /* (arch-ulong-type <gdb:arch>) -> <gdb:type> */ 332 333 static SCM 334 gdbscm_arch_ulong_type (SCM self) 335 { 336 struct type *type 337 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_long; 338 339 return tyscm_scm_from_type (type); 340 } 341 342 /* (arch-float-type <gdb:arch>) -> <gdb:type> */ 343 344 static SCM 345 gdbscm_arch_float_type (SCM self) 346 { 347 struct type *type 348 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_float; 349 350 return tyscm_scm_from_type (type); 351 } 352 353 /* (arch-double-type <gdb:arch>) -> <gdb:type> */ 354 355 static SCM 356 gdbscm_arch_double_type (SCM self) 357 { 358 struct type *type 359 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_double; 360 361 return tyscm_scm_from_type (type); 362 } 363 364 /* (arch-longdouble-type <gdb:arch>) -> <gdb:type> */ 365 366 static SCM 367 gdbscm_arch_longdouble_type (SCM self) 368 { 369 struct type *type 370 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_long_double; 371 372 return tyscm_scm_from_type (type); 373 } 374 375 /* (arch-bool-type <gdb:arch>) -> <gdb:type> */ 376 377 static SCM 378 gdbscm_arch_bool_type (SCM self) 379 { 380 struct type *type 381 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_bool; 382 383 return tyscm_scm_from_type (type); 384 } 385 386 /* (arch-longlong-type <gdb:arch>) -> <gdb:type> */ 387 388 static SCM 389 gdbscm_arch_longlong_type (SCM self) 390 { 391 struct type *type 392 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_long_long; 393 394 return tyscm_scm_from_type (type); 395 } 396 397 /* (arch-ulonglong-type <gdb:arch>) -> <gdb:type> */ 398 399 static SCM 400 gdbscm_arch_ulonglong_type (SCM self) 401 { 402 struct type *type 403 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_unsigned_long_long; 404 405 return tyscm_scm_from_type (type); 406 } 407 408 /* (arch-int8-type <gdb:arch>) -> <gdb:type> */ 409 410 static SCM 411 gdbscm_arch_int8_type (SCM self) 412 { 413 struct type *type 414 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int8; 415 416 return tyscm_scm_from_type (type); 417 } 418 419 /* (arch-uint8-type <gdb:arch>) -> <gdb:type> */ 420 421 static SCM 422 gdbscm_arch_uint8_type (SCM self) 423 { 424 struct type *type 425 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint8; 426 427 return tyscm_scm_from_type (type); 428 } 429 430 /* (arch-int16-type <gdb:arch>) -> <gdb:type> */ 431 432 static SCM 433 gdbscm_arch_int16_type (SCM self) 434 { 435 struct type *type 436 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int16; 437 438 return tyscm_scm_from_type (type); 439 } 440 441 /* (arch-uint16-type <gdb:arch>) -> <gdb:type> */ 442 443 static SCM 444 gdbscm_arch_uint16_type (SCM self) 445 { 446 struct type *type 447 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint16; 448 449 return tyscm_scm_from_type (type); 450 } 451 452 /* (arch-int32-type <gdb:arch>) -> <gdb:type> */ 453 454 static SCM 455 gdbscm_arch_int32_type (SCM self) 456 { 457 struct type *type 458 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int32; 459 460 return tyscm_scm_from_type (type); 461 } 462 463 /* (arch-uint32-type <gdb:arch>) -> <gdb:type> */ 464 465 static SCM 466 gdbscm_arch_uint32_type (SCM self) 467 { 468 struct type *type 469 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint32; 470 471 return tyscm_scm_from_type (type); 472 } 473 474 /* (arch-int64-type <gdb:arch>) -> <gdb:type> */ 475 476 static SCM 477 gdbscm_arch_int64_type (SCM self) 478 { 479 struct type *type 480 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_int64; 481 482 return tyscm_scm_from_type (type); 483 } 484 485 /* (arch-uint64-type <gdb:arch>) -> <gdb:type> */ 486 487 static SCM 488 gdbscm_arch_uint64_type (SCM self) 489 { 490 struct type *type 491 = gdbscm_arch_builtin_type (self, FUNC_NAME)->builtin_uint64; 492 493 return tyscm_scm_from_type (type); 494 } 495 496 /* Initialize the Scheme architecture support. */ 498 499 static const scheme_function arch_functions[] = 500 { 501 { "arch?", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_p), 502 "\ 503 Return #t if the object is a <gdb:arch> object." }, 504 505 { "current-arch", 0, 0, 0, as_a_scm_t_subr (gdbscm_current_arch), 506 "\ 507 Return the <gdb:arch> object representing the architecture of the\n\ 508 currently selected stack frame, if there is one, or the architecture of the\n\ 509 current target if there isn't.\n\ 510 \n\ 511 Arguments: none" }, 512 513 { "arch-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_name), 514 "\ 515 Return the name of the architecture." }, 516 517 { "arch-charset", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_charset), 518 "\ 519 Return name of target character set as a string." }, 520 521 { "arch-wide-charset", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_wide_charset), 522 "\ 523 Return name of target wide character set as a string." }, 524 525 { "arch-void-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_void_type), 526 "\ 527 Return the <gdb:type> object for the \"void\" type\n\ 528 of the architecture." }, 529 530 { "arch-char-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_char_type), 531 "\ 532 Return the <gdb:type> object for the \"char\" type\n\ 533 of the architecture." }, 534 535 { "arch-short-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_short_type), 536 "\ 537 Return the <gdb:type> object for the \"short\" type\n\ 538 of the architecture." }, 539 540 { "arch-int-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_int_type), 541 "\ 542 Return the <gdb:type> object for the \"int\" type\n\ 543 of the architecture." }, 544 545 { "arch-long-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_long_type), 546 "\ 547 Return the <gdb:type> object for the \"long\" type\n\ 548 of the architecture." }, 549 550 { "arch-schar-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_schar_type), 551 "\ 552 Return the <gdb:type> object for the \"signed char\" type\n\ 553 of the architecture." }, 554 555 { "arch-uchar-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_uchar_type), 556 "\ 557 Return the <gdb:type> object for the \"unsigned char\" type\n\ 558 of the architecture." }, 559 560 { "arch-ushort-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_ushort_type), 561 "\ 562 Return the <gdb:type> object for the \"unsigned short\" type\n\ 563 of the architecture." }, 564 565 { "arch-uint-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_uint_type), 566 "\ 567 Return the <gdb:type> object for the \"unsigned int\" type\n\ 568 of the architecture." }, 569 570 { "arch-ulong-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_ulong_type), 571 "\ 572 Return the <gdb:type> object for the \"unsigned long\" type\n\ 573 of the architecture." }, 574 575 { "arch-float-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_float_type), 576 "\ 577 Return the <gdb:type> object for the \"float\" type\n\ 578 of the architecture." }, 579 580 { "arch-double-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_double_type), 581 "\ 582 Return the <gdb:type> object for the \"double\" type\n\ 583 of the architecture." }, 584 585 { "arch-longdouble-type", 1, 0, 0, 586 as_a_scm_t_subr (gdbscm_arch_longdouble_type), 587 "\ 588 Return the <gdb:type> object for the \"long double\" type\n\ 589 of the architecture." }, 590 591 { "arch-bool-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_bool_type), 592 "\ 593 Return the <gdb:type> object for the \"bool\" type\n\ 594 of the architecture." }, 595 596 { "arch-longlong-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_longlong_type), 597 "\ 598 Return the <gdb:type> object for the \"long long\" type\n\ 599 of the architecture." }, 600 601 { "arch-ulonglong-type", 1, 0, 0, 602 as_a_scm_t_subr (gdbscm_arch_ulonglong_type), 603 "\ 604 Return the <gdb:type> object for the \"unsigned long long\" type\n\ 605 of the architecture." }, 606 607 { "arch-int8-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_int8_type), 608 "\ 609 Return the <gdb:type> object for the \"int8\" type\n\ 610 of the architecture." }, 611 612 { "arch-uint8-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_uint8_type), 613 "\ 614 Return the <gdb:type> object for the \"uint8\" type\n\ 615 of the architecture." }, 616 617 { "arch-int16-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_int16_type), 618 "\ 619 Return the <gdb:type> object for the \"int16\" type\n\ 620 of the architecture." }, 621 622 { "arch-uint16-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_uint16_type), 623 "\ 624 Return the <gdb:type> object for the \"uint16\" type\n\ 625 of the architecture." }, 626 627 { "arch-int32-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_int32_type), 628 "\ 629 Return the <gdb:type> object for the \"int32\" type\n\ 630 of the architecture." }, 631 632 { "arch-uint32-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_uint32_type), 633 "\ 634 Return the <gdb:type> object for the \"uint32\" type\n\ 635 of the architecture." }, 636 637 { "arch-int64-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_int64_type), 638 "\ 639 Return the <gdb:type> object for the \"int64\" type\n\ 640 of the architecture." }, 641 642 { "arch-uint64-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_arch_uint64_type), 643 "\ 644 Return the <gdb:type> object for the \"uint64\" type\n\ 645 of the architecture." }, 646 647 END_FUNCTIONS 648 }; 649 650 void 651 gdbscm_initialize_arches (void) 652 { 653 arch_smob_tag = gdbscm_make_smob_type (arch_smob_name, sizeof (arch_smob)); 654 scm_set_smob_print (arch_smob_tag, arscm_print_arch_smob); 655 656 gdbscm_define_functions (arch_functions, 1); 657 } 658
Indexes created Sat Feb 28 05:31:39 UTC 2026