gdb/gmagic.c

   1 #include "defs.h"
   2 #include "gdbcmd.h"
   3 #include "symtab.h"
   4 #include "value.h"
   5 #include "frame.h"
   6 #include "breakpoint.h"
   7 #include "inferior.h"
   8 #include "gdbcore.h"
   9 #include "gmagic.h"
  10 #include <ctype.h>
  11 #include <string.h>
  12
  13 #ifdef DYNAMIC_COMMAND_SUPPORT
  14 #include <dlfcn.h>
  15 #endif
  16
  17 #ifdef ANSI_PROTOTYPES
  18 #include <stdarg.h>
  19 #else
  20 #include <varargs.h>
  21 #endif
  22
  23
  24 /* Maximum number of bytes of extra data to print, or UINT_MAX for no limit.
  25    Note that "set extra-data-max 0" stores UINT_MAX in extra_data_max, which
  26    displays in a show command as "unlimited."  */
  27
  28 static unsigned int extra_data_max;
  29 #define EXTRA_DATA_MAX_DEFAULT          1024
  30
  31 /* Return the number of elements in ARRAY.  */
  32
  33 #define ARRAY_NELEMENTS(array)          (sizeof (array) / sizeof (array[0]))
  34
  35 /* Basic information about a text label */
  36
  37 struct text_label
  38 {
  39   char *name;           /* label name */
  40   CORE_ADDR addr;       /* label value or 0 if label not found */
  41 };
  42
  43 /* Labels within the Magic Cap dispatcher that we need to know about
  44    in order to implement "magic stepping" (that is, stepping over
  45    Magic Cap method dispatches).  The label addresses are refreshed
  46    whenever a new symbol table is loaded.  */
  47
  48 struct text_label dispatch_labels[] =
  49 {
  50   {"__DispatchMethod",         0},      /* normal dispatch entry point */
  51   {"__DispatchInherited",      0},      /* inherited dispatch entry point */
  52   {"__DispatchDelegated",      0},      /* delegated dispatch entry point */
  53   {"__DispatchIntrinsic",      0},      /* intrinsic dispatch entry point */
  54   {"__DoDispatchMethodBpSite", 0},      /* do dispatch site */
  55 };
  56
  57 /* Accessors for the array above.  */
  58
  59 #define DISPATCH_METHOD_ADDR            dispatch_labels[0].addr
  60 #define DISPATCH_INHERITED_ADDR         dispatch_labels[1].addr
  61 #define DISPATCH_DELEGATED_ADDR         dispatch_labels[2].addr
  62 #define DISPATCH_INTRINSIC_ADDR         dispatch_labels[3].addr
  63 #define DO_DISPATCH_METHOD_ADDR         dispatch_labels[4].addr
  64
  65 /* Cached value objects describing functions in the target program that
  66    we call frequently.  These are refreshed whenever a new symbol table
  67    is loaded.  */
  68
  69 static value_ptr remote_get_class_name_val;
  70 static value_ptr remote_get_base_ptr_val;
  71
  72 /* Nonzero means that "magic step" (stepping through the Magic Cap method
  73    dispatcher to the dispatch target) is enabled.  */
  74
  75 static int magic_step_enabled;
  76
  77 /* function prototypes */
  78
  79 static void
  80 print_object PARAMS ((char *args, int dump));
  81
  82 static void
  83 get_class_name PARAMS ((unsigned long objectID, char **name, int *is_scripted));
  84
  85 static CORE_ADDR
  86 get_base_ptr PARAMS ((unsigned long objectID));
  87
  88 static int
  89 should_dump_extra_data PARAMS ((char *class_name));
  90
  91 static void
  92 dump_extra_data PARAMS ((CORE_ADDR addr, unsigned long length));
  93
  94 static value_ptr
  95 call_function_by_name PARAMS ((char *function_name, int nargs, ...));
  96
  97 static value_ptr
  98 call_function_by_value PARAMS ((value_ptr function_value, int nargs, ...));
  99
 100 static value_ptr
 101 vcall_function_by_value PARAMS ((value_ptr function_value, int nargs,
 102                                  va_list args));
 103 static void
 104 local_shell_escape PARAMS ((char *arg));
 105
 106 static CORE_ADDR
 107 lookup_text_label PARAMS ((char *name, value_ptr *val_ptrptr));
 108
 109 static int
 110 is_dispatcher_entry PARAMS ((CORE_ADDR pc));
 111
 112 static int
 113 is_dispatcher_exit PARAMS ((CORE_ADDR pc));
 114
 115
 116 /* This is the GDB handler for the "dobj" command, which prints a
 117    verbose description of an object.  ARGS is a string containing an
 118    expression for the object ID, and FROM_TTY is nonzero if the
 119    command was issued interactively.  */
 120
 121 /* ARGSUSED */
 122 static void
 123 dobj_command (args, from_tty)
 124      char *args;
 125      int from_tty;
 126 {
 127   if (remote_get_class_name_val == NULL)
 128     error ("This version of Magic Cap lacks the runtime support for \"dobj\".");
 129
 130   print_object (args, 1);
 131 }
 132
 133 /* This is the GDB handler for the "pobj" command, which prints a
 134    brief description of an object.  ARGS is a string containing an
 135    expression for the object ID, and FROM_TTY is nonzero if the
 136    command was issued interactively.  */
 137
 138 /* ARGSUSED */
 139 static void
 140 pobj_command (args, from_tty)
 141      char *args;
 142      int from_tty;
 143 {
 144   if (remote_get_class_name_val == NULL)
 145     error ("This version of Magic Cap lacks the runtime support for \"pobj\".");
 146
 147   print_object (args, 0);
 148 }
 149
 150 /* This is the GDB handler for the "cdump" command, which prints a
 151    description of a cluster.  ARGS is a string containing a cluster
 152    selector, and FROM_TTY is nonzero if the command was issued
 153    interactively.
 154
 155    cdump <contextSlot> [/l[ocked]] [/s[tartAddr] <expr>]
 156                        [/c[lass] <className> | <classNumber>] */
 157
 158 /* ARGSUSED */
 159 static void
 160 cdump_command (args, from_tty)
 161      char *args;
 162      int from_tty;
 163 {
 164   char *token;
 165   unsigned long cluster;
 166   CORE_ADDR min_object;
 167   long display_only_locked;
 168   long filter_classes;
 169   long display_only_class_number;
 170   char *display_only_class_name;
 171
 172   if (args == NULL)
 173     error_no_arg ("expression for context slot to dump");
 174
 175   token = strtok (args, " \t");
 176   if (token[0] == '/')
 177     error ("The first argument to cdump must be an expression for the context slot to dump.");
 178
 179   cluster = parse_and_eval_address (token);
 180
 181   /* Initialize option values.  Note that we assume that
 182      sizeof (long) == sizeof (void *) here, in that we pass
 183      min_object as a long, even though it is a pointer.  */
 184
 185   min_object                    = 0;
 186   display_only_locked           = 0;
 187   filter_classes                = 0;
 188   display_only_class_name       = NULL;
 189   display_only_class_number     = 0;
 190
 191   while ((token = strtok (NULL, " \t")) != NULL)
 192     {
 193       if (token[0] != '/')
 194         goto bad_option;
 195
 196       switch (token[1])
 197         {
 198         case 'l':
 199           if (token[2] && strcmp (token + 1, "locked"))
 200             goto bad_option;
 201
 202           display_only_locked = 1;
 203           break;
 204
 205         case 's':
 206           if (token[2] && strcmp (token + 1, "startAddr"))
 207             goto bad_option;
 208
 209           if ((token = strtok (NULL, " \t")) == NULL)
 210             error ("Missing start address expression for `/s' option.");
 211
 212           min_object = parse_and_eval_address (token);
 213           break;
 214
 215         case 'c':
 216           if (token[2] && strcmp (token + 1, "class"))
 217             goto bad_option;
 218
 219           if ((token = strtok (NULL, " \t")) == NULL)
 220             error ("Missing class name or number for `/c' option.");
 221
 222           filter_classes = 1;
 223           if (isdigit (token[0]))
 224             display_only_class_number = parse_and_eval_address (token);
 225           else
 226             display_only_class_name = token;
 227
 228           break;
 229
 230         default:
 231           goto bad_option;
 232         }
 233     }
 234
 235   if (display_only_class_name != NULL)
 236     error ("Sorry, `/c <className>' isn't supported yet.");
 237
 238   (void)call_function_by_name ("cdump", 6, cluster, min_object,
 239                                display_only_locked,
 240                                filter_classes, display_only_class_number,
 241                                display_only_class_name);
 242   return;
 243
 244 bad_option:
 245   error ("Invalid option: `%s'.", token);
 246 }
 247
 248 /* This is the GDB handler for the "esc" command, which lists the
 249    exception handlers for a given actor.  ARGS is a string containing
 250    an expression for the objectID of the actor in question, and FROM_TTY
 251    is nonzero if the command was issued interactively.  */
 252
 253 /* ARGSUSED */
 254 static void
 255 esc_command (args, from_tty)
 256      char *args;
 257      int from_tty;
 258 {
 259   unsigned long object;
 260
 261   if (args == NULL)
 262     error_no_arg ("expression for actor's object ID");
 263
 264   object = parse_and_eval_address (args);
 265   (void)call_function_by_name ("esc", 1, object);
 266 }
 267
 268 /* This is the GDB handler for the "cnum" command, which converts
 269    a class number to a class name.  ARGS is a string containing an
 270    expression for the class number, and FROM_TTY is nonzero if the
 271    command was issued interactively.  */
 272
 273 /* ARGSUSED */
 274 static void
 275 cnum_command (args, from_tty)
 276      char *args;
 277      int from_tty;
 278 {
 279   unsigned long cnum;
 280
 281   if (args == NULL)
 282     error_no_arg ("expression for class number");
 283
 284   cnum = parse_and_eval_address (args);
 285   (void)call_function_by_name ("cnum", 1, cnum);
 286 }
 287
 288 /* This is the GDB handler for the "getint" command, which converts an
 289    intrinsic operation number to the corresponding intrinsic operation name,
 290    or vice-versa.  ARGS is a string containing the intrinsic number or name,
 291    and FROM_TTY is nonzero if the command was issued interactively.  */
 292
 293 /* ARGSUSED */
 294 static void
 295 getint_command (args, from_tty)
 296      char *args;
 297      int from_tty;
 298 {
 299   char shell_command[256];
 300
 301   if (args == NULL)
 302     error_no_arg ("intrinsic operation number or name");
 303
 304   if (isdigit (args[0]))
 305     sprintf (shell_command, "getint %ld", parse_and_eval_address (args));
 306   else
 307     sprintf (shell_command, "getint %s", args);
 308
 309   local_shell_escape (shell_command);
 310 }
 311
 312 /* This is the GDB handler for the "getop" command, which converts an
 313    operation number to the corresponding operation name, or vice-versa.
 314    ARGS is a string containing the operation number or name, and FROM_TTY
 315    is nonzero if the command was issued interactively.  */
 316
 317 /* ARGSUSED */
 318 static void
 319 getop_command (args, from_tty)
 320      char *args;
 321      int from_tty;
 322 {
 323   char shell_command[256];
 324   CORE_ADDR op_number;
 325
 326   if (args == NULL)
 327     error_no_arg ("operation number or name");
 328
 329   if (isdigit (args[0]))
 330     sprintf (shell_command, "getop %ld", parse_and_eval_address (args));
 331   else
 332     sprintf (shell_command, "getop %s", args);
 333
 334   local_shell_escape (shell_command);
 335 }
 336
 337 /* This is the GDB handler for the "getindexical" command, which converts
 338    an indexical number to the corresponding indexical name, or vice-versa.
 339    ARGS is a string containing the indexical number or name, and FROM_TTY
 340    is nonzero if the command was issued interactively.  */
 341
 342 /* ARGSUSED */
 343 static void
 344 getindexical_command (args, from_tty)
 345      char *args;
 346      int from_tty;
 347 {
 348   char shell_command[256];
 349
 350   if (args == NULL)
 351     error_no_arg ("indexical number or name");
 352
 353   if (isdigit (args[0]))
 354     sprintf (shell_command, "getindexical 0x%lx",
 355              parse_and_eval_address (args));
 356   else
 357     sprintf (shell_command, "getindexical %s", args);
 358
 359   local_shell_escape (shell_command);
 360 }
 361
 362 /* This is the GDB handler for the "exc" command, which converts an
 363    exception number to the corresponding exception name, or vice-versa.
 364    ARGS is a string containing the exception number or name, and FROM_TTY
 365    is nonzero if the command was issued interactively.
 366
 367    FIXME why is this one "exc" instead of "getexc?" (inconsistent naming).  */
 368
 369 /* ARGSUSED */
 370 static void
 371 exc_command (args, from_tty)
 372      char *args;
 373      int from_tty;
 374 {
 375   char shell_command[256];
 376
 377   if (args == NULL)
 378     error_no_arg ("exception number or name");
 379
 380   if (isdigit (args[0]))
 381     sprintf (shell_command, "getexc %ld", parse_and_eval_address (args));
 382   else
 383     sprintf (shell_command, "getexc %s", args);
 384
 385   local_shell_escape (shell_command);
 386 }
 387
 388 #ifdef DYNAMIC_COMMAND_SUPPORT
 389 /* Open a dynamic library and invoke an entry point within it.
 390    ARGS is a string containing the names of the dynamic library
 391    and the symbolic entry point, separated by whitespace.  */
 392
 393 /* ARGSUSED */
 394 static void
 395 dlopen_command (args, from_tty)
 396      char *args;
 397      int from_tty;
 398 {
 399   char *p;
 400   void *hdl;
 401   void (*sym)();
 402
 403   if (args == 0)
 404     {
 405       error ("No arguments specified.");
 406       return;
 407     }
 408
 409   p = args;
 410   while (*p != ' ' && *p != '\0')
 411     p++;
 412
 413   if (*p != ' ')
 414     {
 415       error ("Not enough arguments.");
 416       return;
 417     }
 418   *p++ = '\0';
 419
 420   hdl = dlopen (args, RTLD_NOW);
 421   if (hdl == NULL)
 422     {
 423       fprintf (stderr, "%s: %s\n", args, dlerror ());
 424       return;
 425     }
 426
 427   sym = dlsym (hdl, p);
 428   if (sym == NULL)
 429     {
 430       fprintf (stderr, "%s: %s\n", p, dlerror ());
 431       return;
 432     }
 433
 434   sym();
 435 }
 436 #endif /* DYNAMIC_COMMAND_SUPPORT */
 437
 438 /* Given an object ID OBJECT, return a pointer to a type structure
 439    representing the GDB type that describes the layout of the object's
 440    fields in memory (i.e., the "_AllFields" structure corresponding
 441    to the object's class).  */
 442
 443 struct type *
 444 type_of_object (object)
 445      CORE_ADDR object;
 446 {
 447   char *class_name = NULL;
 448   char classAllFieldsName[128];
 449   struct type *type = NULL;
 450   int is_scripted;
 451
 452   get_class_name (object, &class_name, &is_scripted);
 453   sprintf (classAllFieldsName, "%s_AllFields", class_name);
 454   free (class_name);
 455
 456   type = lookup_typename (classAllFieldsName, (struct block *)NULL, 0);
 457   return lookup_pointer_type (type);
 458 }
 459
 460 /* Given OBJECT, an object ID, return the address of the object's
 461    fixed fields.  */
 462
 463 CORE_ADDR
 464 baseptr_of_object (object)
 465      unsigned long object;
 466 {
 467   return get_base_ptr (object) + kSizeOfObjectHeader;
 468 }
 469
 470 /* Given an expression for an object ID, ARGS, print information about
 471    the object--including its class, the values of its fixed fields, and
 472    the values in its extra data block.  */
 473
 474 /* ARGSUSED */
 475 static void
 476 print_object (args, dump)
 477      char *args;
 478      int dump;
 479 {
 480   CORE_ADDR addr;
 481   unsigned long object, object_length;
 482   char *class_name = NULL;
 483   char class_all_fields_name[128];
 484   struct type *type;
 485   int is_scripted;
 486   struct cleanup *old_chain;
 487
 488   if (args == NULL)
 489     error_no_arg ("expression for object ID");
 490
 491   object = parse_and_eval_address (args);
 492
 493   /* check for nilObject */
 494
 495   if (!object)
 496     {
 497       printf_filtered ("\"%s\" evaluates to nilObject.\n", args);
 498       return;
 499     }
 500
 501   /* allow shortcut for system object ids */
 502
 503   if (IsObjectID (object))
 504     object |= 1 << kIDBitUsable;
 505   else if (object < 0x5000)
 506     object |= (1 << kIDBitObject) | (1 << kIDBitUsable); /* 0x84000000 */
 507
 508   /* Get the name of the object's class, as well as the GDB type that
 509      describes the layout of the object's fixed fields.  */
 510
 511   get_class_name (object, &class_name, &is_scripted);
 512   old_chain = make_cleanup (free_current_contents, &class_name);
 513
 514   sprintf (class_all_fields_name, "%s_AllFields", class_name);
 515   type = lookup_typename (class_all_fields_name, (struct block *)NULL, 1);
 516
 517   /* Get pointer to object's fields.
 518      FIXME: ADDR is actually an (ObjectHeader *); should use normal expression
 519      evaluator to extract the length member, rather than hardwiring the
 520      format of the structure in this code.  */
 521
 522   addr = get_base_ptr (object);
 523   object_length = read_memory_unsigned_integer (addr, 4);
 524   object_length -= kSizeOfObjectHeader;
 525   addr += kSizeOfObjectHeader;
 526
 527   if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_UNDEF
 528                        && !(TYPE_FLAGS (type) & TYPE_FLAG_STUB)))
 529     {
 530       if (dump)
 531         {
 532           unsigned long fixed_length;
 533
 534           printf_filtered ("Object 0x%08lx%s at address 0x%08lx of class %s\n",
 535                            object, (is_scripted) ? " (scripted)" : "",
 536                            addr, class_name);
 537
 538           /* If the object has fixed fields, dump them.  */
 539
 540           if (type != NULL)
 541             {
 542               value_ptr valptr = value_at_lazy (type, addr);
 543               int histindex = record_latest_value (valptr);
 544
 545               if (histindex >= 0)
 546                 printf_filtered ("$%d = ", histindex);
 547
 548               value_print (valptr, gdb_stdout, 0, Val_prettyprint);
 549               puts_filtered ("\n");
 550               fixed_length = TYPE_LENGTH (type);
 551             }
 552           else
 553             fixed_length = 0;
 554
 555           /* If the object's length is less than that of its fixed fields,
 556              warn the user.  */
 557
 558           if (object_length < fixed_length)
 559             {
 560               error ("Warning: object is too small (should be at least %d bytes, is %d bytes).",
 561                      fixed_length, object_length);
 562             }
 563
 564           /* Dump the object's extra data, if any.  should_dump_extra_data ()
 565              filters out classes (e.g. Cluster) that have too much extra data
 566              to be dumped usefully in this format.  */
 567
 568           if (should_dump_extra_data (class_name))
 569             {
 570               dump_extra_data (addr + fixed_length,
 571                                object_length - fixed_length);
 572             }
 573         }
 574       else
 575         {
 576           struct type *pointer_type;
 577           value_ptr valptr;
 578           int histindex;
 579
 580           pointer_type = lookup_pointer_type ((type == NULL) ?
 581                                               builtin_type_void : type);
 582           valptr = value_from_longest (pointer_type, addr);
 583
 584           histindex = record_latest_value (valptr);
 585           if (histindex >= 0)
 586             printf_filtered ("$%d = ", histindex);
 587
 588           value_print (valptr, gdb_stdout, 0, Val_prettyprint);
 589           puts_filtered ("\n");
 590         }
 591     }
 592   do_cleanups (old_chain);
 593 }
 594
 595 /* Get the name of the class of the object referenced by OBJECTID.
 596    *NAME is set to a pointer to the string containing the class
 597    name; it is the caller's responsibility to free the memory for
 598    the string.  *IS_SCRIPTED is set to nonzero if the object is
 599    scripted, zero otherwise.  */
 600
 601 static void
 602 get_class_name (objectID, name, is_scripted)
 603      unsigned long objectID;
 604      char **name;
 605      int *is_scripted;
 606 {
 607   value_ptr val;
 608   int errno_val;
 609
 610   val = call_function_by_value (remote_get_class_name_val, 1, objectID);
 611
 612   /* As RemoteGetClassName() is currently (9/21/95) written, an empty string,
 613      rather than a nil pointer, is returned upon failure.  I'm leaving the
 614      value_logical_not test in anyway, though, just for added robustness.  */
 615
 616   if (!value_logical_not (val))
 617     {
 618       (void)target_read_string (value_as_pointer (val), name, 256, &errno_val);
 619       if (errno_val)
 620         error ("Can't read class name for object 0x%08lx.", objectID);
 621
 622       if (**name)
 623         {
 624           char *scripted_suffix;
 625
 626           if ((scripted_suffix = strstr (*name, " (scripted)")) != NULL)
 627             {
 628               *scripted_suffix = '\0';
 629               *is_scripted = 1;
 630             }
 631           else
 632             *is_scripted = 0;
 633
 634           return;
 635         }
 636       else
 637         free (*name);
 638     }
 639
 640   error ("Bad object ID: 0x%08lx.", objectID);
 641 }
 642
 643 /* Given an object ID, return a pointer to the object's data.  */
 644
 645 static CORE_ADDR
 646 get_base_ptr (objectID)
 647      unsigned long objectID;
 648 {
 649   register value_ptr val;
 650
 651   val = call_function_by_value (remote_get_base_ptr_val, 1, objectID);
 652
 653   if (value_logical_not (val))
 654     error ("Could not get base pointer to object.");
 655
 656   return value_as_pointer (val);
 657 }
 658
 659 /* Return nonzero if we should dump the extra data for an object
 660    of class CLASS_NAME.
 661
 662    FIXME this only works for explicitly named classes, and doesn't
 663    handle subclasses.  */
 664
 665 static int
 666 should_dump_extra_data (class_name)
 667      char *class_name;
 668 {
 669   int i;
 670   char **name;
 671   static char *dont_dump_extra_classes[] =
 672     {
 673       "Cluster"
 674     };
 675
 676   for (i = 0, name = dont_dump_extra_classes;
 677        i < ARRAY_NELEMENTS(dont_dump_extra_classes);
 678        i++, name++)
 679     {
 680       if (!strcmp (class_name, *name))
 681         return 0;
 682     }
 683
 684   return 1;
 685 }
 686
 687 /* Given ADDR, the address of an object's extra data block, and LENGTH,
 688    the length of that block in bytes, dump the object's extra data to
 689    standard output.  */
 690
 691 static void
 692 dump_extra_data (addr, length)
 693      CORE_ADDR addr;
 694      unsigned long length;
 695 {
 696   unsigned long buf[5];
 697   int chunk;
 698   int chunk_longs;
 699   int i;
 700   int bytes_printed;
 701   char *p;
 702
 703   bytes_printed = 0;
 704
 705   while (length > 3 && bytes_printed < extra_data_max)
 706     {
 707       QUIT;             /* allow user to interrupt dump */
 708
 709       /* read a chunk of extra data */
 710
 711       chunk = (length > 16) ? 16 : length;
 712       memset (buf, 0, sizeof (buf));
 713       read_memory (addr, (char *) &buf, chunk);
 714
 715       /* format data as hex longwords */
 716
 717       chunk_longs = chunk >> 2;
 718       for (i = 0; i < chunk_longs; i++)
 719         printf_filtered ("%08lx ",
 720                          extract_unsigned_integer (buf + i, sizeof (long)));
 721
 722       /* pad to 4 longs */
 723
 724       for (i = chunk_longs; i < 4; i++)
 725         puts_filtered ("         ");
 726
 727       puts_filtered ("| ");
 728
 729       /* format data as ascii bytes */
 730
 731       for (i = 0, p = (char*)buf; i < chunk; i++, p++)
 732         {
 733           if (!isprint (*p))
 734             *p = '.';
 735         }
 736       printf_filtered ("%s |\n", buf);
 737
 738       addr += chunk;
 739       length -= chunk;
 740       bytes_printed += chunk;
 741     }
 742
 743   if (length > 0)
 744     printf_filtered ("(%d bytes of extra data remaining but not displayed.)\n",
 745                      length);
 746 }
 747
 748 /* Given the name of a function in the target program and a list of
 749    long arguments, call the function and return a pointer to a value
 750    object describing the function's return value.  NAME is a string
 751    containing the name of the function to be called; NARGS is the
 752    number of arguments to the function; and the remaining parameters
 753    are the arguments to passed to the function, all assumed to be of
 754    type long.  */
 755
 756 static value_ptr
 757 #ifdef ANSI_PROTOTYPES
 758 call_function_by_name (char *function_name, int nargs, ...)
 759 #else
 760 call_function_by_name (va_alist)
 761      va_dcl
 762 #endif
 763 {
 764   va_list args;
 765   value_ptr return_value;
 766   value_ptr function_value;
 767 #ifndef ANSI_PROTOTYPES
 768   char *function_name;
 769   int nargs;
 770
 771   va_start (args);
 772   function_name = va_arg (args, char *);
 773   nargs = va_arg (args, int);
 774 #else
 775   va_start (args, nargs);
 776 #endif
 777
 778   /* Find the address of function NAME in the inferior.  */
 779
 780   if (!lookup_text_label (function_name, &function_value))
 781     error ("Execution of this command requires the debugged program to have a function \"%s.\"",
 782            function_name);
 783
 784   /* Call the function.  */
 785
 786   return_value = vcall_function_by_value (function_value, nargs, args);
 787   va_end (args);
 788
 789   return return_value;
 790 }
 791
 792 /* Given a value object describing a function in the target program and
 793    a list of long arguments, call the function and return a pointer to a
 794    value object describing the function's return value.  FUNCTION_VALUE
 795    is a pointer to a value struct describing the function; NARGS is the
 796    number of arguments to the function; and the remaining parameters are
 797    the arguments to passed to the function, all assumed to be of type long.  */
 798
 799 static value_ptr
 800 #ifdef ANSI_PROTOTYPES
 801 call_function_by_value (value_ptr function_value, int nargs, ...)
 802 #else
 803 call_function_by_value (va_alist)
 804      va_dcl
 805 #endif
 806 {
 807   va_list args;
 808   value_ptr return_value;
 809 #ifndef ANSI_PROTOTYPES
 810   value_ptr function_value;
 811   int nargs;
 812
 813   va_start (args);
 814   function_value = va_arg (args, value_ptr);
 815   nargs = va_arg (args, int);
 816 #else
 817   va_start (args, nargs);
 818 #endif
 819
 820   /* Call the function and return its return value.  */
 821
 822   return_value = vcall_function_by_value (function_value, nargs, args);
 823   va_end (args);
 824
 825   return return_value;
 826 }
 827
 828 /* Helper routine for call_function_by_name and call_function_by_value
 829    above.  This function does the work of collecting the function
 830    arguments into an array of value objects, and then invoking
 831    call_function_by_hand to do the real work.  FUNCTION_VALUE is a
 832    pointer to a value object describing the function to be called,
 833    NARGS is the number of arguments to the function, and ARGS is a
 834    list (va_list) of the arguments to the function, all assumed to
 835    be of type long.
 836
 837    Returns a pointer to a value object describing the return value
 838    of the function.  */
 839
 840 static value_ptr
 841 vcall_function_by_value (function_value, nargs, args)
 842      value_ptr function_value;
 843      int nargs;
 844      va_list args;
 845 {
 846   value_ptr *arg_values;
 847   value_ptr return_value;
 848   struct cleanup *old_chain;
 849   int i;
 850
 851   /* Construct a vector of value objects describing the arguments
 852      to the function to be called.  */
 853
 854   arg_values = (value_ptr *) xmalloc (nargs * sizeof (value_ptr));
 855   old_chain = make_cleanup (free_current_contents, &arg_values);
 856
 857   for (i = 0; i < nargs; i++)
 858     arg_values[i] = value_from_longest (builtin_type_long,
 859                                         (LONGEST) va_arg (args, unsigned long));
 860
 861   /* Call the function and return its return value.  */
 862
 863   return_value = call_function_by_hand (function_value, nargs, arg_values);
 864   do_cleanups (old_chain);
 865   return return_value;
 866 }
 867
 868 /* Invoke a shell, supplying ARG as the command to be executed.  */
 869
 870 static void
 871 local_shell_escape (arg)
 872      char *arg;
 873 {
 874 #ifdef CANT_FORK
 875   /* FIXME: what about errors (I don't know how GO32 system() handles
 876      them)?  */
 877   system (arg);
 878 #else /* Can fork.  */
 879   int rc, status, pid;
 880   char *p, *user_shell;
 881
 882   if ((user_shell = (char *) getenv ("SHELL")) == NULL)
 883     user_shell = "/bin/sh";
 884
 885   /* Get the name of the shell for arg0 */
 886   if ((p = strrchr (user_shell, '/')) == NULL)
 887     p = user_shell;
 888   else
 889     p++;                        /* Get past '/' */
 890
 891   if ((pid = fork()) == 0)
 892     {
 893       if (!arg)
 894         execl (user_shell, p, 0);
 895       else
 896         execl (user_shell, p, "-c", arg, 0);
 897
 898       fprintf_unfiltered (gdb_stderr, "Cannot execute %s: %s\n", user_shell,
 899                           safe_strerror (errno));
 900       gdb_flush (gdb_stderr);
 901       _exit (0177);
 902     }
 903
 904   if (pid != -1)
 905     while ((rc = wait (&status)) != pid && rc != -1)
 906       ;
 907   else
 908     error ("Fork failed");
 909 #endif /* Can fork.  */
 910 }
 911
 912 /* Lookup NAME as a text label in the target program.  If NAME is the
 913    name of a function, and VAL_PTRPTR is not NULL, a pointer to a value
 914    object describing the function is stored at VAL_PTRPTR.
 915
 916    Returns the text address to which the label refers, or 0 if the
 917    label is not found in the target program.  */
 918
 919 static CORE_ADDR
 920 lookup_text_label (name, val_ptrptr)
 921      char *name;
 922      value_ptr *val_ptrptr;
 923 {
 924   struct symbol *sym;
 925   CORE_ADDR addr;
 926
 927   addr = 0;
 928
 929   /* Try looking up NAME as a first-class symbol.  */
 930
 931   sym = lookup_symbol (name, 0, VAR_NAMESPACE, 0, NULL);
 932   if (sym != NULL)
 933     {
 934       switch (SYMBOL_CLASS (sym))
 935         {
 936         case LOC_BLOCK:
 937           addr = BLOCK_START (SYMBOL_BLOCK_VALUE (sym));
 938           if (val_ptrptr != NULL)
 939             *val_ptrptr = value_of_variable (sym, NULL);
 940
 941           break;
 942
 943         case LOC_STATIC:
 944         case LOC_LABEL:
 945           addr = SYMBOL_VALUE_ADDRESS (sym);
 946           break;
 947         }
 948     }
 949   else
 950     {
 951       struct minimal_symbol *msymbol;
 952       struct type *type;
 953
 954       /* Try to find a minimal symbol for NAME.  */
 955
 956       msymbol = lookup_minimal_symbol (name, "", (struct objfile *) NULL);
 957       if (msymbol != NULL)
 958         {
 959           addr = SYMBOL_VALUE_ADDRESS (msymbol);
 960           if (val_ptrptr != NULL)
 961             {
 962               type = lookup_pointer_type (builtin_type_char);
 963               type = lookup_function_type (type);
 964               type = lookup_pointer_type (type);
 965               *val_ptrptr = value_from_longest (type, addr);
 966             }
 967         }
 968     }
 969   return addr;
 970 }
 971
 972 /* The following two routines adapt GDB's framework for stepping over
 973    shared library trampoline code to the problem of stepping over the
 974    Magic Cap method dispatcher.  While the method dispatcher is not a
 975    shared library trampoline, we can use the interfaces for controlling
 976    stepping over trampolines to do what we want.  */
 977
 978 /* Return nonzero if STOP_PC is within the Magic Cap method dispatcher.
 979    NAME is unused.  This function serves as the implementation of both
 980    IN_SOLIB_CALL_TRAMPOLINE() and IN_SOLIB_RETURN_TRAMPOLINE() when GDB
 981    is configured to target Magic Cap.  We don't need to distinguish
 982    between the two types of trampolines (because they're not really
 983    trampolines); we just need to tell GDB to set a breakpoint at the
 984    site of the next "hop" on our way through the dispatcher, and to
 985    keep going.  */
 986
 987 int
 988 magic_in_dispatcher (stop_pc, name)
 989      CORE_ADDR stop_pc;
 990      char *name;
 991 {
 992   return magic_step_enabled
 993          && (is_dispatcher_entry (stop_pc) || is_dispatcher_exit (stop_pc));
 994 }
 995
 996 /* Determine if STOP_PC is an address within the Magic Cap method
 997    dispatcher, and if so, return the address at which GDB should set
 998    a step resume breakpoint in order to skip over the dispatcher code.
 999    In fact, we have to skip over the dispatcher in two separate "hops:"
1000    the first hop gets us from a dispatcher entry point to the dispatcher
1001    exit site; the second hop gets us from this exit site to the first
1002    instruction of the method.
1003
1004    This function serves as the implementation of SKIP_TRAMPOLINE_CODE()
1005    when GDB is configured to target Magic Cap.  */
1006
1007 CORE_ADDR
1008 magic_skip_dispatcher (stop_pc)
1009      CORE_ADDR stop_pc;
1010 {
1011   /* If magic stepping is disabled, return 0, indicating that GDB should
1012      process this step event normally.  This will have the effect of
1013      allowing the user to step through the dispatcher code itself.  */
1014
1015   if (!magic_step_enabled)
1016     return 0;
1017
1018   /* If the program is stopped at an entry point to the dispatcher,
1019      tell GDB to set a breakpoint at a well-known label in the
1020      dispatcher where we will be able to determine the address of
1021      the method to which we are dispatching.  Note that the dispatcher
1022      has hair to ensure that the code at this label is executed when we
1023      are completing a top-level dispatch; recursive dispatches generated
1024      from within the dispatcher do not exit through this code.  */
1025
1026   if (is_dispatcher_entry (stop_pc))
1027     return DO_DISPATCH_METHOD_ADDR;
1028
1029   /* If we have hit the breakpoint set previously at a dispatcher exit site,
1030      determine the method address and tell GDB to set a breakpoint there.  */
1031
1032   else if (is_dispatcher_exit (stop_pc))
1033     return read_register (14);  /* assumes that we branch through t6 */
1034   else
1035     return 0;
1036 }
1037
1038 /* Return nonzero if PC is an entry point to the Magic Cap method
1039    dispatcher.  */
1040
1041 static int
1042 is_dispatcher_entry (pc)
1043      CORE_ADDR pc;
1044 {
1045   return pc == DISPATCH_METHOD_ADDR
1046          || pc == DISPATCH_INTRINSIC_ADDR
1047          || pc == DISPATCH_INHERITED_ADDR
1048          || pc == DISPATCH_DELEGATED_ADDR;
1049 }
1050
1051 /* Return nonzero if PC is an exit site from the Magic Cap method
1052    dispatcher.  */
1053
1054 static int
1055 is_dispatcher_exit (pc)
1056      CORE_ADDR pc;
1057 {
1058   return pc == DO_DISPATCH_METHOD_ADDR;
1059 }
1060
1061 /* Store away addresses in the inferior we need to control single-stepping
1062    through Magic Cap method dispatches, as well as other addresses of
1063    interest in Magic Cap.  */
1064
1065 void
1066 init_magic ()
1067 {
1068   struct text_label *label;
1069   int i;
1070
1071   /* Cache method dispatch label addresses.  */
1072
1073   for (i = 0, label = dispatch_labels;
1074        i < ARRAY_NELEMENTS (dispatch_labels);
1075        i++, label++)
1076     {
1077       if (!(label->addr = lookup_text_label (label->name, NULL)))
1078         {
1079           /* If we can't find all of the dispatcher addresses, don't attempt
1080              to do magic stepping.  */
1081
1082           magic_step_enabled = 0;
1083           break;
1084         }
1085     }
1086
1087   /* Cache value objects for RemoteGetClassName () and RemoteGetBasePtr (),
1088      which are used to implement the "dobj" and "pobj" commands.  Note that
1089      we must call release_value () on these values to prevent GDB from freeing
1090      them automatically.  */
1091
1092   if (remote_get_class_name_val != NULL)
1093     {
1094       value_free (remote_get_class_name_val);
1095       remote_get_class_name_val = NULL;
1096     }
1097
1098   if (remote_get_base_ptr_val != NULL)
1099     {
1100       value_free (remote_get_base_ptr_val);
1101       remote_get_base_ptr_val = NULL;
1102     }
1103
1104   if (lookup_text_label ("RemoteGetClassName", &remote_get_class_name_val))
1105     {
1106       release_value (remote_get_class_name_val);
1107
1108       if (lookup_text_label ("RemoteGetBasePtr", &remote_get_base_ptr_val))
1109         release_value (remote_get_base_ptr_val);
1110     }
1111 }
1112
1113 /* Hook routine called when an inferior (i.e., debugged) process is
1114    created.  */
1115
1116 void
1117 magic_create_inferior_hook ()
1118 {
1119   struct symbol *sym = lookup_symbol ("gHandleError", NULL, VAR_NAMESPACE,
1120                                       NULL, NULL);
1121   if (sym)
1122     {
1123       CORE_ADDR addr = SYMBOL_VALUE (sym);
1124       unsigned long errorDebugger = 2;
1125
1126       target_write_memory (addr, (char *) &errorDebugger, 4);
1127     }
1128 }
1129
1130 /* Initialization routine for magic.c.  This is where we define debugger
1131    commands specific to Magic Cap.  */
1132
1133 void
1134 _initialize_magic ()
1135 {
1136   add_com ("dobj", class_support, dobj_command,
1137            "Display object contents.\n\
1138 Usage: dobj <objectID>\n\
1139 Where: <objectID> is an expression for the object ID to dump.");
1140
1141   add_com ("pobj", class_support, pobj_command,
1142            "Print object base pointer.\n\
1143 Usage: pobj <objectID>\n\
1144 Where: <objectID> is an expression for the object ID to examine.");
1145
1146   add_com ("cdump", class_support, cdump_command,
1147            concat ("Display the contents of a cluster.\n\
1148 Usage: cdump <contextSlot> [/l[ocked]] [/s[tartAddr] <addr>]\n\
1149                            [/c[lass] <classNumber>]\n\
1150 Where: <contextSlot> is an expression describing the cluster to dump;\n\
1151            if <contextSlot> is a number between 0x8 and 0xf, it is \n\
1152            interpreted as the high-order nibble of an object ID\n\
1153            belonging to the cluster to dump, with the second highest-\n\
1154            order nibble assumed to be 0.  (For example, \"cdump 8\" and \n\
1155            \"cdump 0xa\" dump the System Persistent and Persistent RAM\n\
1156            clusters, respectively.)\n",
1157                    "\n\
1158            if <contextSlot> is a number between 0xf0 and 0x100, it is\n\
1159            interpreted as the high-order byte of an object ID belonging to\n\
1160            the cluster to dump.  (For example, \"cdump 0x88\" and \n\
1161            \"cdump 0xa8\" dump the Locked Persistent and Transient RAM\n\
1162            clusters, respectively.)\n",
1163                    "\n\
1164        /locked or /l indicates that only locked objects are to be displayed.\n\
1165 \n\
1166        /startAddr or /s indicates that only objects whose base pointers are\n\
1167            greater than or equal to the address specified by the following\n\
1168            expression (<startAddr>) are to be displayed.\n\
1169 \n\
1170        /class or /c indicates that only objects of the class specified by\n\
1171            the following expression <classNumber> are to be displayed.",
1172                    NULL));
1173
1174   add_com ("esc", class_support, esc_command,
1175            "List all the exception handlers for a given actor.\n\
1176 Usage: esc <objectID>\n\
1177 Where: <objectID> is an expression for the object ID of the actor\n\
1178            whose exception handlers are to be listed.");
1179
1180   add_com ("cnum", class_support, cnum_command,
1181            "Convert class number to name.\n\
1182 Usage: cnum <classNumber>\n\
1183 Where: <classNumber> is an expression for the class number to convert.");
1184
1185   add_com ("getint", class_support, getint_command,
1186            "Convert intrinsic name to number or vice versa.\n\
1187 Usage: getint <intrinsicName> | <intrinsicNumber>\n\
1188 Where: <intrinsicName> | <intrinsicNumber> is an intrinsic operation name\n\
1189            to be converted to an operation number, or an intrinsic operation\n\
1190            number to be converted to an operation name.");
1191
1192   add_com ("getop", class_support, getop_command,
1193            "Convert operation name to number or vice versa.\n\
1194 Usage: getop <operationName> | <operationNumber>\n\
1195 Where: <operationName> | <operationNumber> is an operation name to be\n\
1196            converted to an operation number, or an operation number to\n\
1197            be converted to an operation name.");
1198
1199   add_com ("getindexical", class_support, getindexical_command,
1200            "Convert indexical name to number or vice versa.\n\
1201 Usage: getindexical <indexicalName> | <indexicalNumber>\n\
1202 Where: <indexicalName> | <indexicalNumber> is an indexical name to be\n\
1203            converted to an an indexical number, or an indexical number\n\
1204            to be converted to an indexical name.");
1205
1206   add_com ("exc", class_support, exc_command,
1207            "Convert exception name to number or vice versa.\n\
1208 Usage: exc <exceptionName> | <exceptionNumber>\n\
1209 Where: <exceptionName> | <exceptionNumber> is an exception name to be\n\
1210            converted to an an exception number, or an exception number\n\
1211            to be converted to an exception name.");
1212
1213   add_show_from_set
1214     (add_set_cmd ("extra-data-max", class_support, var_uinteger,
1215                   (char *) &extra_data_max,
1216                   "Set limit on number of bytes of extra data to print.\n\
1217 This command sets an upper limit on the number of bytes of extra\n\
1218 data displayed by the \"dobj\" command when dumping a Magic Cap\n\
1219 object.  \"set extra-data-max 0\" causes there to be no limit.",
1220                   &setlist),
1221      &showlist);
1222
1223   extra_data_max = EXTRA_DATA_MAX_DEFAULT;
1224
1225   add_show_from_set
1226     (add_set_cmd ("magic-step", class_support, var_boolean,
1227                   (char *) &magic_step_enabled,
1228                   "Set stepping over Magic Cap method dispatches.\n\
1229 When set to \"on\" (the default), issuing a \"step\" command at a Magic Cap\n\
1230 operation call site will cause the program to stop at the first line of\n\
1231 the corresponding method.  Set this to \"off\" only if you need to debug\n\
1232 the dispatcher itself.",
1233                   &setlist),
1234      &showlist);
1235
1236   magic_step_enabled = 1;
1237
1238 #ifdef DYNAMIC_COMMAND_SUPPORT
1239   add_com ("dlopen", class_support, dlopen_command,
1240          "Load the dynamic library specified and execute the specified symbol");
1241 #endif
1242 }