gdb/ada-tasks.c

   1 /* Copyright (C) 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004,
   2    2005, 2007, 2008 Free Software Foundation, Inc.
   3
   4    This file is part of GDB.
   5
   6    This program is free software; you can redistribute it and/or modify
   7    it under the terms of the GNU General Public License as published by
   8    the Free Software Foundation; either version 3 of the License, or
   9    (at your option) any later version.
  10
  11    This program is distributed in the hope that it will be useful,
  12    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14    GNU General Public License for more details.
  15
  16    You should have received a copy of the GNU General Public License
  17    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  18
  19 #include "defs.h"
  20 #include "observer.h"
  21 #include "gdbcmd.h"
  22 #include "target.h"
  23 #include "ada-lang.h"
  24 #include "gdbcore.h"
  25 #include "inferior.h"
  26 #include "gdbthread.h"
  27
  28 /* The name of the array in the GNAT runtime where the Ada Task Control
  29    Block of each task is stored.  */
  30 #define KNOWN_TASKS_NAME "system__tasking__debug__known_tasks"
  31
  32 /* The maximum number of tasks known to the Ada runtime */
  33 static const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
  34
  35 enum task_states
  36 {
  37   Unactivated,
  38   Runnable,
  39   Terminated,
  40   Activator_Sleep,
  41   Acceptor_Sleep,
  42   Entry_Caller_Sleep,
  43   Async_Select_Sleep,
  44   Delay_Sleep,
  45   Master_Completion_Sleep,
  46   Master_Phase_2_Sleep,
  47   Interrupt_Server_Idle_Sleep,
  48   Interrupt_Server_Blocked_Interrupt_Sleep,
  49   Timer_Server_Sleep,
  50   AST_Server_Sleep,
  51   Asynchronous_Hold,
  52   Interrupt_Server_Blocked_On_Event_Flag
  53 };
  54
  55 /* A short description corresponding to each possible task state.  */
  56 static char *task_states[] = {
  57   _("Unactivated"),
  58   _("Runnable"),
  59   _("Terminated"),
  60   _("Child Activation Wait"),
  61   _("Accept Statement"),
  62   _("Waiting on entry call"),
  63   _("Async Select Wait"),
  64   _("Delay Sleep"),
  65   _("Child Termination Wait"),
  66   _("Wait Child in Term Alt"),
  67   "",
  68   "",
  69   "",
  70   "",
  71   _("Asynchronous Hold"),
  72   ""
  73 };
  74
  75 /* A longer description corresponding to each possible task state.  */
  76 static char *long_task_states[] = {
  77   _("Unactivated"),
  78   _("Runnable"),
  79   _("Terminated"),
  80   _("Waiting for child activation"),
  81   _("Blocked in accept statement"),
  82   _("Waiting on entry call"),
  83   _("Asynchronous Selective Wait"),
  84   _("Delay Sleep"),
  85   _("Waiting for children termination"),
  86   _("Waiting for children in terminate alternative"),
  87   "",
  88   "",
  89   "",
  90   "",
  91   _("Asynchronous Hold"),
  92   ""
  93 };
  94
  95 /* The index of certain important fields in the Ada Task Control Block
  96    record and sub-records.  */
  97
  98 struct tcb_fieldnos
  99 {
 100   /* Fields in record Ada_Task_Control_Block.  */
 101   int common;
 102   int entry_calls;
 103   int atc_nesting_level;
 104
 105   /* Fields in record Common_ATCB.  */
 106   int state;
 107   int parent;
 108   int priority;
 109   int image;
 110   int image_len;     /* This field may be missing.  */
 111   int call;
 112   int ll;
 113
 114   /* Fields in Task_Primitives.Private_Data.  */
 115   int ll_thread;
 116   int ll_lwp;        /* This field may be missing.  */
 117
 118   /* Fields in Common_ATCB.Call.all.  */
 119   int call_self;
 120 };
 121
 122 /* The type description for the ATCB record and subrecords, and
 123    the associated tcb_fieldnos. For efficiency reasons, these are made
 124    static globals so that we can compute them only once the first time
 125    and reuse them later.  Set to NULL if the types haven't been computed
 126    yet, or if they may be obsolete (for instance after having loaded
 127    a new binary).  */
 128
 129 static struct type *atcb_type = NULL;
 130 static struct type *atcb_common_type = NULL;
 131 static struct type *atcb_ll_type = NULL;
 132 static struct type *atcb_call_type = NULL;
 133 static struct tcb_fieldnos fieldno;
 134
 135 /* Set to 1 when the cached address of System.Tasking.Debug.Known_Tasks
 136    might be stale and so needs to be recomputed.  */
 137 static int ada_tasks_check_symbol_table = 1;
 138
 139 /* The list of Ada tasks.
 140
 141    Note: To each task we associate a number that the user can use to
 142    reference it - this number is printed beside each task in the tasks
 143    info listing displayed by "info tasks".  This number is equal to
 144    its index in the vector + 1.  Reciprocally, to compute the index
 145    of a task in the vector, we need to substract 1 from its number.  */
 146 typedef struct ada_task_info ada_task_info_s;
 147 DEF_VEC_O(ada_task_info_s);
 148 static VEC(ada_task_info_s) *task_list = NULL;
 149
 150 /* When non-zero, this flag indicates that the current task_list
 151    is obsolete, and should be recomputed before it is accessed.  */
 152 static int stale_task_list_p = 1;
 153
 154 /* Return the task number of the task whose ptid is PTID, or zero
 155    if the task could not be found.  */
 156
 157 int
 158 ada_get_task_number (ptid_t ptid)
 159 {
 160   int i;
 161
 162   for (i=0; i < VEC_length (ada_task_info_s, task_list); i++)
 163     if (ptid_equal (VEC_index (ada_task_info_s, task_list, i)->ptid, ptid))
 164       return i + 1;
 165
 166   return 0;  /* No matching task found.  */
 167 }
 168
 169 /* Return the task number of the task that matches TASK_ID, or zero
 170    if the task could not be found.  */
 171
 172 static int
 173 get_task_number_from_id (CORE_ADDR task_id)
 174 {
 175   int i;
 176
 177   for (i = 0; i < VEC_length (ada_task_info_s, task_list); i++)
 178     {
 179       struct ada_task_info *task_info =
 180         VEC_index (ada_task_info_s, task_list, i);
 181
 182       if (task_info->task_id == task_id)
 183         return i + 1;
 184     }
 185
 186   /* Task not found.  Return 0.  */
 187   return 0;
 188 }
 189
 190 /* Return non-zero if TASK_NUM is a valid task number.  */
 191
 192 int
 193 valid_task_id (int task_num)
 194 {
 195   return (task_num > 0
 196           && task_num <= VEC_length (ada_task_info_s, task_list));
 197 }
 198
 199 /* Return the task info associated to the Environment Task.
 200    This function assumes that the inferior does in fact use tasking.  */
 201
 202 struct ada_task_info *
 203 ada_get_environment_task (void)
 204 {
 205   ada_build_task_list (0);
 206   gdb_assert (VEC_length (ada_task_info_s, task_list) > 0);
 207
 208   /* We use a little bit of insider knowledge to determine which task
 209      is the Environment Task:  We know that this task is created first,
 210      and thus should always be task #1, which is at index 0 of the
 211      TASK_LIST.  */
 212   return (VEC_index (ada_task_info_s, task_list, 0));
 213 }
 214
 215 /* Call the ITERATOR function once for each Ada task that hasn't been
 216    terminated yet.  */
 217
 218 void
 219 iterate_over_live_ada_tasks (ada_task_list_iterator_ftype *iterator)
 220 {
 221   int i, nb_tasks;
 222   struct ada_task_info *task;
 223
 224   ada_build_task_list (0);
 225   nb_tasks = VEC_length (ada_task_info_s, task_list);
 226
 227   for (i = 0; i < nb_tasks; i++)
 228     {
 229       task = VEC_index (ada_task_info_s, task_list, i);
 230       if (!ada_task_is_alive (task))
 231         continue;
 232       iterator (task);
 233     }
 234 }
 235
 236 /* Extract the contents of the value as a string whose length is LENGTH,
 237    and store the result in DEST.  */
 238
 239 static void
 240 value_as_string (char *dest, struct value *val, int length)
 241 {
 242   memcpy (dest, value_contents (val), length);
 243   dest[length] = '\0';
 244 }
 245
 246 /* Extract the string image from the fat string corresponding to VAL,
 247    and store it in DEST.  If the string length is greater than MAX_LEN,
 248    then truncate the result to the first MAX_LEN characters of the fat
 249    string.  */
 250
 251 static void
 252 read_fat_string_value (char *dest, struct value *val, int max_len)
 253 {
 254   struct value *array_val;
 255   struct value *bounds_val;
 256   int len;
 257
 258   /* The following variables are made static to avoid recomputing them
 259      each time this function is called.  */
 260   static int initialize_fieldnos = 1;
 261   static int array_fieldno;
 262   static int bounds_fieldno;
 263   static int upper_bound_fieldno;
 264
 265   /* Get the index of the fields that we will need to read in order
 266      to extract the string from the fat string.  */
 267   if (initialize_fieldnos)
 268     {
 269       struct type *type = value_type (val);
 270       struct type *bounds_type;
 271
 272       array_fieldno = ada_get_field_index (type, "P_ARRAY", 0);
 273       bounds_fieldno = ada_get_field_index (type, "P_BOUNDS", 0);
 274
 275       bounds_type = TYPE_FIELD_TYPE (type, bounds_fieldno);
 276       if (TYPE_CODE (bounds_type) == TYPE_CODE_PTR)
 277         bounds_type = TYPE_TARGET_TYPE (bounds_type);
 278       if (TYPE_CODE (bounds_type) != TYPE_CODE_STRUCT)
 279         error (_("Unknown task name format. Aborting"));
 280       upper_bound_fieldno = ada_get_field_index (bounds_type, "UB0", 0);
 281
 282       initialize_fieldnos = 0;
 283     }
 284
 285   /* Get the size of the task image by checking the value of the bounds.
 286      The lower bound is always 1, so we only need to read the upper bound.  */
 287   bounds_val = value_ind (value_field (val, bounds_fieldno));
 288   len = value_as_long (value_field (bounds_val, upper_bound_fieldno));
 289
 290   /* Make sure that we do not read more than max_len characters...  */
 291   if (len > max_len)
 292     len = max_len;
 293
 294   /* Extract LEN characters from the fat string.  */
 295   array_val = value_ind (value_field (val, array_fieldno));
 296   read_memory (VALUE_ADDRESS (array_val), dest, len);
 297
 298   /* Add the NUL character to close the string.  */
 299   dest[len] = '\0';
 300 }
 301
 302 /* Return the address of the Known_Tasks array maintained in
 303    the Ada Runtime.  Return NULL if the array could not be found,
 304    meaning that the inferior program probably does not use tasking.
 305
 306    In order to provide a fast response time, this function caches
 307    the Known_Tasks array address after the lookup during the first
 308    call. Subsequent calls will simply return this cached address.  */
 309
 310 static CORE_ADDR
 311 get_known_tasks_addr (void)
 312 {
 313   static CORE_ADDR known_tasks_addr = 0;
 314
 315   if (ada_tasks_check_symbol_table)
 316     {
 317       struct symbol *sym;
 318       struct minimal_symbol *msym;
 319
 320       msym = lookup_minimal_symbol (KNOWN_TASKS_NAME, NULL, NULL);
 321       if (msym != NULL)
 322         known_tasks_addr = SYMBOL_VALUE_ADDRESS (msym);
 323       else
 324         {
 325           if (target_lookup_symbol (KNOWN_TASKS_NAME, &known_tasks_addr) != 0)
 326             return 0;
 327         }
 328
 329       /* FIXME: brobecker 2003-03-05: Here would be a much better place
 330          to attach the ada-tasks observers, instead of doing this
 331          unconditionaly in _initialize_tasks. This would avoid an
 332          unecessary notification when the inferior does not use tasking
 333          or as long as the user does not use the ada-tasks commands.
 334          Unfortunately, this is not possible for the moment: the current
 335          code resets ada__tasks_check_symbol_table back to 1 whenever
 336          symbols for a new program are being loaded. If we place the
 337          observers intialization here, we will end up adding new observers
 338          everytime we do the check for Ada tasking-related symbols
 339          above. This would currently have benign effects, but is still
 340          undesirable. The cleanest approach is probably to create a new
 341          observer to notify us when the user is debugging a new program.
 342          We would then reset ada__tasks_check_symbol_table back to 1
 343          during the notification, but also detach all observers.
 344          BTW: observers are probably not reentrant, so detaching during
 345          a notification may not be the safest thing to do... Sigh...
 346          But creating the new observer would be a good idea in any case,
 347          since this allow us to make ada__tasks_check_symbol_table
 348          static, which is a good bonus.  */
 349       ada_tasks_check_symbol_table = 0;
 350     }
 351
 352   return known_tasks_addr;
 353 }
 354
 355 /* Get from the debugging information the type description of all types
 356    related to the Ada Task Control Block that will be needed in order to
 357    read the list of known tasks in the Ada runtime.  Also return the
 358    associated ATCB_FIELDNOS.
 359
 360    Error handling:  Any data missing from the debugging info will cause
 361    an error to be raised, and none of the return values to be set.
 362    Users of this function can depend on the fact that all or none of the
 363    return values will be set.  */
 364
 365 static void
 366 get_tcb_types_info (struct type **atcb_type,
 367                     struct type **atcb_common_type,
 368                     struct type **atcb_ll_type,
 369                     struct type **atcb_call_type,
 370                     struct tcb_fieldnos *atcb_fieldnos)
 371 {
 372   struct type *type;
 373   struct type *common_type;
 374   struct type *ll_type;
 375   struct type *call_type;
 376   struct tcb_fieldnos fieldnos;
 377
 378   const char *atcb_name = "system__tasking__ada_task_control_block___XVE";
 379   const char *atcb_name_fixed = "system__tasking__ada_task_control_block";
 380   const char *common_atcb_name = "system__tasking__common_atcb";
 381   const char *private_data_name = "system__task_primitives__private_data";
 382   const char *entry_call_record_name = "system__tasking__entry_call_record";
 383
 384   struct symbol *atcb_sym =
 385     lookup_symbol (atcb_name, NULL, VAR_DOMAIN, NULL);
 386   const struct symbol *common_atcb_sym =
 387     lookup_symbol (common_atcb_name, NULL, VAR_DOMAIN, NULL);
 388   const struct symbol *private_data_sym =
 389     lookup_symbol (private_data_name, NULL, VAR_DOMAIN, NULL);
 390   const struct symbol *entry_call_record_sym =
 391     lookup_symbol (entry_call_record_name, NULL, VAR_DOMAIN, NULL);
 392
 393   if (atcb_sym == NULL || atcb_sym->type == NULL)
 394     {
 395       /* In Ravenscar run-time libs, the  ATCB does not have a dynamic
 396          size, so the symbol name differs.  */
 397       atcb_sym = lookup_symbol (atcb_name_fixed, NULL, VAR_DOMAIN, NULL);
 398
 399       if (atcb_sym == NULL || atcb_sym->type == NULL)
 400         error (_("Cannot find Ada_Task_Control_Block type. Aborting"));
 401
 402       type = atcb_sym->type;
 403     }
 404   else
 405     {
 406       /* Get a static representation of the type record
 407          Ada_Task_Control_Block.  */
 408       type = atcb_sym->type;
 409       type = ada_template_to_fixed_record_type_1 (type, NULL, 0, NULL, 0);
 410     }
 411
 412   if (common_atcb_sym == NULL || common_atcb_sym->type == NULL)
 413     error (_("Cannot find Common_ATCB type. Aborting"));
 414   if (private_data_sym == NULL || private_data_sym->type == NULL)
 415     error (_("Cannot find Private_Data type. Aborting"));
 416   if (entry_call_record_sym == NULL || entry_call_record_sym->type == NULL)
 417     error (_("Cannot find Entry_Call_Record type. Aborting"));
 418
 419   /* Get the type for Ada_Task_Control_Block.Common.  */
 420   common_type = common_atcb_sym->type;
 421
 422   /* Get the type for Ada_Task_Control_Bloc.Common.Call.LL.  */
 423   ll_type = private_data_sym->type;
 424
 425   /* Get the type for Common_ATCB.Call.all.  */
 426   call_type = entry_call_record_sym->type;
 427
 428   /* Get the field indices.  */
 429   fieldnos.common = ada_get_field_index (type, "common", 0);
 430   fieldnos.entry_calls = ada_get_field_index (type, "entry_calls", 1);
 431   fieldnos.atc_nesting_level =
 432     ada_get_field_index (type, "atc_nesting_level", 1);
 433   fieldnos.state = ada_get_field_index (common_type, "state", 0);
 434   fieldnos.parent = ada_get_field_index (common_type, "parent", 1);
 435   fieldnos.priority = ada_get_field_index (common_type, "base_priority", 0);
 436   fieldnos.image = ada_get_field_index (common_type, "task_image", 1);
 437   fieldnos.image_len = ada_get_field_index (common_type, "task_image_len", 1);
 438   fieldnos.call = ada_get_field_index (common_type, "call", 1);
 439   fieldnos.ll = ada_get_field_index (common_type, "ll", 0);
 440   fieldnos.ll_thread = ada_get_field_index (ll_type, "thread", 0);
 441   fieldnos.ll_lwp = ada_get_field_index (ll_type, "lwp", 1);
 442   fieldnos.call_self = ada_get_field_index (call_type, "self", 0);
 443
 444   /* On certain platforms such as x86-windows, the "lwp" field has been
 445      named "thread_id".  This field will likely be renamed in the future,
 446      but we need to support both possibilities to avoid an unnecessary
 447      dependency on a recent compiler.  We therefore try locating the
 448      "thread_id" field in place of the "lwp" field if we did not find
 449      the latter.  */
 450   if (fieldnos.ll_lwp < 0)
 451     fieldnos.ll_lwp = ada_get_field_index (ll_type, "thread_id", 1);
 452
 453   /* Set all the out parameters all at once, now that we are certain
 454      that there are no potential error() anymore.  */
 455   *atcb_type = type;
 456   *atcb_common_type = common_type;
 457   *atcb_ll_type = ll_type;
 458   *atcb_call_type = call_type;
 459   *atcb_fieldnos = fieldnos;
 460 }
 461
 462 /* Build the PTID of the task from its COMMON_VALUE, which is the "Common"
 463    component of its ATCB record.  This PTID needs to match the PTID used
 464    by the thread layer.  */
 465
 466 static ptid_t
 467 ptid_from_atcb_common (struct value *common_value)
 468 {
 469   long thread = 0;
 470   CORE_ADDR lwp = 0;
 471   struct value *ll_value;
 472   ptid_t ptid;
 473
 474   ll_value = value_field (common_value, fieldno.ll);
 475
 476   if (fieldno.ll_lwp >= 0)
 477     lwp = value_as_address (value_field (ll_value, fieldno.ll_lwp));
 478   thread = value_as_long (value_field (ll_value, fieldno.ll_thread));
 479
 480   ptid = target_get_ada_task_ptid (lwp, thread);
 481
 482   return ptid;
 483 }
 484
 485 /* Read the ATCB data of a given task given its TASK_ID (which is in practice
 486    the address of its assocated ATCB record), and store the result inside
 487    TASK_INFO.  */
 488
 489 static void
 490 read_atcb (CORE_ADDR task_id, struct ada_task_info *task_info)
 491 {
 492   struct value *tcb_value;
 493   struct value *common_value;
 494   struct value *atc_nesting_level_value;
 495   struct value *entry_calls_value;
 496   struct value *entry_calls_value_element;
 497   int called_task_fieldno = -1;
 498   const char ravenscar_task_name[] = "Ravenscar task";
 499
 500   if (atcb_type == NULL)
 501     get_tcb_types_info (&atcb_type, &atcb_common_type, &atcb_ll_type,
 502                         &atcb_call_type, &fieldno);
 503
 504   tcb_value = value_from_contents_and_address (atcb_type, NULL, task_id);
 505   common_value = value_field (tcb_value, fieldno.common);
 506
 507   /* Fill in the task_id.  */
 508
 509   task_info->task_id = task_id;
 510
 511   /* Compute the name of the task.
 512
 513      Depending on the GNAT version used, the task image is either a fat
 514      string, or a thin array of characters.  Older versions of GNAT used
 515      to use fat strings, and therefore did not need an extra field in
 516      the ATCB to store the string length. For efficiency reasons, newer
 517      versions of GNAT replaced the fat string by a static buffer, but this
 518      also required the addition of a new field named "Image_Len" containing
 519      the length of the task name. The method used to extract the task name
 520      is selected depending on the existence of this field.
 521
 522      In some run-time libs (e.g. Ravenscar), the name is not in the ATCB;
 523      we may want to get it from the first user frame of the stack. For now,
 524      we just give a dummy name.  */
 525
 526   if (fieldno.image_len == -1)
 527     {
 528       if (fieldno.image >= 0)
 529         read_fat_string_value (task_info->name,
 530                                value_field (common_value, fieldno.image),
 531                                sizeof (task_info->name) - 1);
 532       else
 533         strcpy (task_info->name, ravenscar_task_name);
 534     }
 535   else
 536     {
 537       int len = value_as_long (value_field (common_value, fieldno.image_len));
 538
 539       value_as_string (task_info->name,
 540                        value_field (common_value, fieldno.image), len);
 541     }
 542
 543   /* Compute the task state and priority.  */
 544
 545   task_info->state = value_as_long (value_field (common_value, fieldno.state));
 546   task_info->priority =
 547     value_as_long (value_field (common_value, fieldno.priority));
 548
 549   /* If the ATCB contains some information about the parent task,
 550      then compute it as well.  Otherwise, zero.  */
 551
 552   if (fieldno.parent >= 0)
 553     task_info->parent =
 554       value_as_address (value_field (common_value, fieldno.parent));
 555   else
 556     task_info->parent = 0;
 557
 558
 559   /* If the ATCB contains some information about entry calls, then
 560      compute the "called_task" as well.  Otherwise, zero.  */
 561
 562   if (fieldno.atc_nesting_level > 0 && fieldno.entry_calls > 0)
 563     {
 564       /* Let My_ATCB be the Ada task control block of a task calling the
 565          entry of another task; then the Task_Id of the called task is
 566          in My_ATCB.Entry_Calls (My_ATCB.ATC_Nesting_Level).Called_Task.  */
 567       atc_nesting_level_value = value_field (tcb_value,
 568                                              fieldno.atc_nesting_level);
 569       entry_calls_value =
 570         ada_coerce_to_simple_array_ptr (value_field (tcb_value,
 571                                                      fieldno.entry_calls));
 572       entry_calls_value_element =
 573         value_subscript (entry_calls_value, atc_nesting_level_value);
 574       called_task_fieldno =
 575         ada_get_field_index (value_type (entry_calls_value_element),
 576                              "called_task", 0);
 577       task_info->called_task =
 578         value_as_address (value_field (entry_calls_value_element,
 579                                        called_task_fieldno));
 580     }
 581   else
 582     {
 583       task_info->called_task = 0;
 584     }
 585
 586   /* If the ATCB cotnains some information about RV callers,
 587      then compute the "caller_task".  Otherwise, zero.  */
 588
 589   task_info->caller_task = 0;
 590   if (fieldno.call >= 0)
 591     {
 592       /* Get the ID of the caller task from Common_ATCB.Call.all.Self.
 593          If Common_ATCB.Call is null, then there is no caller.  */
 594       const CORE_ADDR call =
 595         value_as_address (value_field (common_value, fieldno.call));
 596       struct value *call_val;
 597
 598       if (call != 0)
 599         {
 600           call_val =
 601             value_from_contents_and_address (atcb_call_type, NULL, call);
 602           task_info->caller_task =
 603             value_as_address (value_field (call_val, fieldno.call_self));
 604         }
 605     }
 606
 607   /* And finally, compute the task ptid.  */
 608
 609   if (ada_task_is_alive (task_info))
 610     task_info->ptid = ptid_from_atcb_common (common_value);
 611   else
 612     task_info->ptid = null_ptid;
 613 }
 614
 615 /* Read the ATCB info of the given task (identified by TASK_ID), and
 616    add the result to the TASK_LIST.  */
 617
 618 static void
 619 add_ada_task (CORE_ADDR task_id)
 620 {
 621   struct ada_task_info task_info;
 622
 623   read_atcb (task_id, &task_info);
 624   VEC_safe_push (ada_task_info_s, task_list, &task_info);
 625 }
 626
 627 /* Read the Known_Tasks array from the inferior memory, and store
 628    it in TASK_LIST.  Return non-zero upon success.  */
 629
 630 static int
 631 read_known_tasks_array (void)
 632 {
 633   const int target_ptr_byte =
 634     gdbarch_ptr_bit (current_gdbarch) / TARGET_CHAR_BIT;
 635   const CORE_ADDR known_tasks_addr = get_known_tasks_addr ();
 636   const int known_tasks_size = target_ptr_byte * MAX_NUMBER_OF_KNOWN_TASKS;
 637   gdb_byte *known_tasks = alloca (known_tasks_size);
 638   int i;
 639
 640   /* Step 1: Clear the current list, if necessary.  */
 641   VEC_truncate (ada_task_info_s, task_list, 0);
 642
 643   /* If the application does not use task, then no more needs to be done.
 644      It is important to have the task list cleared (see above) before we
 645      return, as we don't want a stale task list to be used...  This can
 646      happen for instance when debugging a non-multitasking program after
 647      having debugged a multitasking one.  */
 648   if (known_tasks_addr == 0)
 649     return 0;
 650
 651   /* Step 2: Build a new list by reading the ATCBs from the Known_Tasks
 652      array in the Ada runtime.  */
 653   read_memory (known_tasks_addr, known_tasks, known_tasks_size);
 654   for (i = 0; i < MAX_NUMBER_OF_KNOWN_TASKS; i++)
 655     {
 656       struct type *data_ptr_type =
 657         builtin_type (current_gdbarch)->builtin_data_ptr;
 658       CORE_ADDR task_id =
 659         extract_typed_address (known_tasks + i * target_ptr_byte,
 660                                data_ptr_type);
 661
 662       if (task_id != 0)
 663         add_ada_task (task_id);
 664     }
 665
 666   /* Step 3: Unset stale_task_list_p, to avoid re-reading the Known_Tasks
 667      array unless needed.  Then report a success.  */
 668   stale_task_list_p = 0;
 669
 670   return 1;
 671 }
 672
 673 /* Builds the task_list by reading the Known_Tasks array from
 674    the inferior.  Prints an appropriate message and returns non-zero
 675    if it failed to build this list.  */
 676
 677 int
 678 ada_build_task_list (int warn_if_null)
 679 {
 680   if (!target_has_stack)
 681     error (_("Cannot inspect Ada tasks when program is not running"));
 682
 683   if (stale_task_list_p)
 684     read_known_tasks_array ();
 685
 686   if (task_list == NULL)
 687     {
 688       if (warn_if_null)
 689         printf_filtered (_("Your application does not use any Ada tasks.\n"));
 690       return 0;
 691     }
 692
 693   return 1;
 694 }
 695
 696 /* Return non-zero iff the task STATE corresponds to a non-terminated
 697    task state.  */
 698
 699 int
 700 ada_task_is_alive (struct ada_task_info *task_info)
 701 {
 702   return (task_info->state != Terminated);
 703 }
 704
 705 /* Print a one-line description of the task whose number is TASKNO.
 706    The formatting should fit the "info tasks" array.  */
 707
 708 static void
 709 short_task_info (int taskno)
 710 {
 711   const struct ada_task_info *const task_info =
 712     VEC_index (ada_task_info_s, task_list, taskno - 1);
 713   int active_task_p;
 714
 715   gdb_assert (task_info != NULL);
 716
 717   /* Print a star if this task is the current task (or the task currently
 718      selected).  */
 719
 720   active_task_p = ptid_equal (task_info->ptid, inferior_ptid);
 721   if (active_task_p)
 722     printf_filtered ("*");
 723   else
 724     printf_filtered (" ");
 725
 726   /* Print the task number.  */
 727   printf_filtered ("%3d", taskno);
 728
 729   /* Print the Task ID.  */
 730   printf_filtered (" %9lx", (long) task_info->task_id);
 731
 732   /* Print the Task ID of the task parent.  */
 733   printf_filtered (" %4d", get_task_number_from_id (task_info->parent));
 734
 735   /* Print the base priority of the task.  */
 736   printf_filtered (" %3d", task_info->priority);
 737
 738   /* Print the task current state.  */
 739   if (task_info->caller_task)
 740     printf_filtered (_(" Accepting RV with %-4d"),
 741                      get_task_number_from_id (task_info->caller_task));
 742   else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
 743     printf_filtered (_(" Waiting on RV with %-3d"),
 744                      get_task_number_from_id (task_info->called_task));
 745   else if (task_info->state == Runnable && active_task_p)
 746     /* Replace "Runnable" by "Running" since this is the active task.  */
 747     printf_filtered (" %-22s", "Running");
 748   else
 749     printf_filtered (" %-22s", task_states[task_info->state]);
 750
 751   /* Finally, print the task name.  */
 752   if (task_info->name[0] != '\0')
 753     printf_filtered (" %s\n", task_info->name);
 754   else
 755     printf_filtered (_(" <no name>\n"));
 756 }
 757
 758 /* Print a list containing a short description of all Ada tasks.  */
 759 /* FIXME: Shouldn't we be using ui_out??? */
 760
 761 static void
 762 info_tasks (int from_tty)
 763 {
 764   int taskno;
 765   const int nb_tasks = VEC_length (ada_task_info_s, task_list);
 766
 767   printf_filtered (_("  ID       TID P-ID Pri State                  Name\n"));
 768
 769   for (taskno = 1; taskno <= nb_tasks; taskno++)
 770     short_task_info (taskno);
 771 }
 772
 773 /* Print a detailed description of the Ada task whose ID is TASKNO_STR.  */
 774
 775 static void
 776 info_task (char *taskno_str, int from_tty)
 777 {
 778   const int taskno = value_as_long (parse_and_eval (taskno_str));
 779   struct ada_task_info *task_info;
 780   int parent_taskno = 0;
 781
 782   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, task_list))
 783     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
 784              "see the IDs of currently known tasks"), taskno);
 785   task_info = VEC_index (ada_task_info_s, task_list, taskno - 1);
 786
 787   /* Print the Ada task ID.  */
 788   printf_filtered (_("Ada Task: %s\n"), paddr_nz (task_info->task_id));
 789
 790   /* Print the name of the task.  */
 791   if (task_info->name[0] != '\0')
 792     printf_filtered (_("Name: %s\n"), task_info->name);
 793   else
 794     printf_filtered (_("<no name>\n"));
 795
 796   /* Print the TID and LWP.  */
 797   printf_filtered (_("Thread: %#lx\n"), ptid_get_tid (task_info->ptid));
 798   printf_filtered (_("LWP: %#lx\n"), ptid_get_lwp (task_info->ptid));
 799
 800   /* Print who is the parent (if any).  */
 801   if (task_info->parent != 0)
 802     parent_taskno = get_task_number_from_id (task_info->parent);
 803   if (parent_taskno)
 804     {
 805       struct ada_task_info *parent =
 806         VEC_index (ada_task_info_s, task_list, parent_taskno - 1);
 807
 808       printf_filtered (_("Parent: %d"), parent_taskno);
 809       if (parent->name[0] != '\0')
 810         printf_filtered (" (%s)", parent->name);
 811       printf_filtered ("\n");
 812     }
 813   else
 814     printf_filtered (_("No parent\n"));
 815
 816   /* Print the base priority.  */
 817   printf_filtered (_("Base Priority: %d\n"), task_info->priority);
 818
 819   /* print the task current state.  */
 820   {
 821     int target_taskno = 0;
 822
 823     if (task_info->caller_task)
 824       {
 825         target_taskno = get_task_number_from_id (task_info->caller_task);
 826         printf_filtered (_("State: Accepting rendezvous with %d"),
 827                          target_taskno);
 828       }
 829     else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
 830       {
 831         target_taskno = get_task_number_from_id (task_info->called_task);
 832         printf_filtered (_("State: Waiting on task %d's entry"),
 833                          target_taskno);
 834       }
 835     else
 836       printf_filtered ("State: %s", long_task_states[task_info->state]);
 837
 838     if (target_taskno)
 839       {
 840         struct ada_task_info *target_task_info =
 841           VEC_index (ada_task_info_s, task_list, target_taskno - 1);
 842
 843         if (target_task_info->name[0] != '\0')
 844           printf_filtered (" (%s)", target_task_info->name);
 845       }
 846
 847     printf_filtered ("\n");
 848   }
 849 }
 850
 851 /* If ARG is empty or null, then print a list of all Ada tasks.
 852    Otherwise, print detailed information about the task whose ID
 853    is ARG.
 854
 855    Does nothing if the program doesn't use Ada tasking.  */
 856
 857 static void
 858 info_tasks_command (char *arg, int from_tty)
 859 {
 860   const int task_list_built = ada_build_task_list (1);
 861
 862   if (!task_list_built)
 863     return;
 864
 865   if (arg == NULL || *arg == '\0')
 866     info_tasks (from_tty);
 867   else
 868     info_task (arg, from_tty);
 869 }
 870
 871 /* Print a message telling the user id of the current task.
 872    This function assumes that tasking is in use in the inferior.  */
 873
 874 static void
 875 display_current_task_id (void)
 876 {
 877   const int current_task = ada_get_task_number (inferior_ptid);
 878
 879   if (current_task == 0)
 880     printf_filtered (_("[Current task is unknown]\n"));
 881   else
 882     printf_filtered (_("[Current task is %d]\n"), current_task);
 883 }
 884
 885 /* Parse and evaluate TIDSTR into a task id, and try to switch to
 886    that task.  Print an error message if the task switch failed.  */
 887
 888 static void
 889 task_command_1 (char *taskno_str, int from_tty)
 890 {
 891   const int taskno = value_as_long (parse_and_eval (taskno_str));
 892   struct ada_task_info *task_info;
 893
 894   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, task_list))
 895     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
 896              "see the IDs of currently known tasks"), taskno);
 897   task_info = VEC_index (ada_task_info_s, task_list, taskno - 1);
 898
 899   if (!ada_task_is_alive (task_info))
 900     error (_("Cannot switch to task %d: Task is no longer running"), taskno);
 901
 902   switch_to_thread (task_info->ptid);
 903   ada_find_printable_frame (get_selected_frame (NULL));
 904   printf_filtered (_("[Switching to task %d]\n"), taskno);
 905   print_stack_frame (get_selected_frame (NULL),
 906                      frame_relative_level (get_selected_frame (NULL)), 1);
 907 }
 908
 909
 910 /* Print the ID of the current task if TASKNO_STR is empty or NULL.
 911    Otherwise, switch to the task indicated by TASKNO_STR.  */
 912
 913 static void
 914 task_command (char *taskno_str, int from_tty)
 915 {
 916   const int task_list_built = ada_build_task_list (1);
 917
 918   if (!task_list_built)
 919     return;
 920
 921   if (taskno_str == NULL || taskno_str[0] == '\0')
 922     display_current_task_id ();
 923   else
 924     {
 925       /* Task switching in core files doesn't work, either because:
 926            1. Thread support is not implemented with core files
 927            2. Thread support is implemented, but the thread IDs created
 928               after having read the core file are not the same as the ones
 929               that were used during the program life, before the crash.
 930               As a consequence, there is no longer a way for the debugger
 931               to find the associated thead ID of any given Ada task.
 932          So, instead of attempting a task switch without giving the user
 933          any clue as to what might have happened, just error-out with
 934          a message explaining that this feature is not supported.  */
 935       if (!target_has_execution)
 936         error (_("\
 937 Task switching not supported when debugging from core files\n\
 938 (use thread support instead)"));
 939       task_command_1 (taskno_str, from_tty);
 940     }
 941 }
 942
 943 /* Indicate that the task list may have changed, so invalidate the cache.  */
 944
 945 void
 946 ada_task_list_changed (void)
 947 {
 948   stale_task_list_p = 1;
 949 }
 950
 951 /* The 'normal_stop' observer notification callback.  */
 952
 953 static void
 954 ada_normal_stop_observer (struct bpstats *unused_args)
 955 {
 956   /* The inferior has been resumed, and just stopped. This means that
 957      our task_list needs to be recomputed before it can be used again.  */
 958   ada_task_list_changed ();
 959 }
 960
 961 /* A routine to be called when the objfiles have changed.  */
 962
 963 void
 964 ada_new_objfile_observer (struct objfile *objfile)
 965 {
 966   /* Invalidate all cached data that were extracted from an objfile.  */
 967
 968   atcb_type = NULL;
 969   atcb_common_type = NULL;
 970   atcb_ll_type = NULL;
 971   atcb_call_type = NULL;
 972
 973   ada_tasks_check_symbol_table = 1;
 974 }
 975
 976 void
 977 _initialize_tasks (void)
 978 {
 979   /* Attach various observers.  */
 980   observer_attach_normal_stop (ada_normal_stop_observer);
 981   observer_attach_new_objfile (ada_new_objfile_observer);
 982
 983   /* Some new commands provided by this module.  */
 984   add_info ("tasks", info_tasks_command,
 985             _("Provide information about all known Ada tasks"));
 986   add_cmd ("task", class_run, task_command,
 987            _("Use this command to switch between Ada tasks.\n\
 988 Without argument, this command simply prints the current task ID"),
 989            &cmdlist);
 990 }
 991