[Ada] Remove `from_tty' parameter from ada-tasks.c:info_tasks
[platform/upstream/binutils.git] / gdb / ada-tasks.c
1 /* Copyright (C) 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004, 2005,
2    2007, 2008, 2009, 2010, 2011 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 #include "progspace.h"
28 #include "objfiles.h"
29
30 /* The name of the array in the GNAT runtime where the Ada Task Control
31    Block of each task is stored.  */
32 #define KNOWN_TASKS_NAME "system__tasking__debug__known_tasks"
33
34 /* The maximum number of tasks known to the Ada runtime.  */
35 static const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
36
37 /* The name of the variable in the GNAT runtime where the head of a task
38    chain is saved.  This is an alternate mechanism to find the list of known
39    tasks.  */
40 #define KNOWN_TASKS_LIST "system__tasking__debug__first_task"
41
42 enum task_states
43 {
44   Unactivated,
45   Runnable,
46   Terminated,
47   Activator_Sleep,
48   Acceptor_Sleep,
49   Entry_Caller_Sleep,
50   Async_Select_Sleep,
51   Delay_Sleep,
52   Master_Completion_Sleep,
53   Master_Phase_2_Sleep,
54   Interrupt_Server_Idle_Sleep,
55   Interrupt_Server_Blocked_Interrupt_Sleep,
56   Timer_Server_Sleep,
57   AST_Server_Sleep,
58   Asynchronous_Hold,
59   Interrupt_Server_Blocked_On_Event_Flag,
60   Activating,
61   Acceptor_Delay_Sleep
62 };
63
64 /* A short description corresponding to each possible task state.  */
65 static const char *task_states[] = {
66   N_("Unactivated"),
67   N_("Runnable"),
68   N_("Terminated"),
69   N_("Child Activation Wait"),
70   N_("Accept or Select Term"),
71   N_("Waiting on entry call"),
72   N_("Async Select Wait"),
73   N_("Delay Sleep"),
74   N_("Child Termination Wait"),
75   N_("Wait Child in Term Alt"),
76   "",
77   "",
78   "",
79   "",
80   N_("Asynchronous Hold"),
81   "",
82   N_("Activating"),
83   N_("Selective Wait")
84 };
85
86 /* A longer description corresponding to each possible task state.  */
87 static const char *long_task_states[] = {
88   N_("Unactivated"),
89   N_("Runnable"),
90   N_("Terminated"),
91   N_("Waiting for child activation"),
92   N_("Blocked in accept or select with terminate"),
93   N_("Waiting on entry call"),
94   N_("Asynchronous Selective Wait"),
95   N_("Delay Sleep"),
96   N_("Waiting for children termination"),
97   N_("Waiting for children in terminate alternative"),
98   "",
99   "",
100   "",
101   "",
102   N_("Asynchronous Hold"),
103   "",
104   N_("Activating"),
105   N_("Blocked in selective wait statement")
106 };
107
108 /* The index of certain important fields in the Ada Task Control Block
109    record and sub-records.  */
110
111 struct atcb_fieldnos
112 {
113   /* Fields in record Ada_Task_Control_Block.  */
114   int common;
115   int entry_calls;
116   int atc_nesting_level;
117
118   /* Fields in record Common_ATCB.  */
119   int state;
120   int parent;
121   int priority;
122   int image;
123   int image_len;     /* This field may be missing.  */
124   int activation_link;
125   int call;
126   int ll;
127
128   /* Fields in Task_Primitives.Private_Data.  */
129   int ll_thread;
130   int ll_lwp;        /* This field may be missing.  */
131
132   /* Fields in Common_ATCB.Call.all.  */
133   int call_self;
134 };
135
136 /* This module's per-program-space data.  */
137
138 struct ada_tasks_pspace_data
139 {
140   /* Nonzero if the data has been initialized.  If set to zero,
141      it means that the data has either not been initialized, or
142      has potentially become stale.  */
143   int initialized_p;
144
145   /* The ATCB record type.  */
146   struct type *atcb_type;
147
148   /* The ATCB "Common" component type.  */
149   struct type *atcb_common_type;
150
151   /* The type of the "ll" field, from the atcb_common_type.  */
152   struct type *atcb_ll_type;
153
154   /* The type of the "call" field, from the atcb_common_type.  */
155   struct type *atcb_call_type;
156
157   /* The index of various fields in the ATCB record and sub-records.  */
158   struct atcb_fieldnos atcb_fieldno;
159 };
160
161 /* Key to our per-program-space data.  */
162 static const struct program_space_data *ada_tasks_pspace_data_handle;
163
164 typedef struct ada_task_info ada_task_info_s;
165 DEF_VEC_O(ada_task_info_s);
166
167 /* The kind of data structure used by the runtime to store the list
168    of Ada tasks.  */
169
170 enum ada_known_tasks_kind
171 {
172   /* Use this value when we haven't determined which kind of structure
173      is being used, or when we need to recompute it.
174
175      We set the value of this enumerate to zero on purpose: This allows
176      us to use this enumerate in a structure where setting all fields
177      to zero will result in this kind being set to unknown.  */
178   ADA_TASKS_UNKNOWN = 0,
179
180   /* This value means that we did not find any task list.  Unless
181      there is a bug somewhere, this means that the inferior does not
182      use tasking.  */
183   ADA_TASKS_NOT_FOUND,
184
185   /* This value means that the task list is stored as an array.
186      This is the usual method, as it causes very little overhead.
187      But this method is not always used, as it does use a certain
188      amount of memory, which might be scarse in certain environments.  */
189   ADA_TASKS_ARRAY,
190
191   /* This value means that the task list is stored as a linked list.
192      This has more runtime overhead than the array approach, but
193      also require less memory when the number of tasks is small.  */
194   ADA_TASKS_LIST,
195 };
196
197 /* This module's per-inferior data.  */
198
199 struct ada_tasks_inferior_data
200 {
201   /* The type of data structure used by the runtime to store
202      the list of Ada tasks.  The value of this field influences
203      the interpretation of the known_tasks_addr field below:
204        - ADA_TASKS_UNKNOWN: The value of known_tasks_addr hasn't
205          been determined yet;
206        - ADA_TASKS_NOT_FOUND: The program probably does not use tasking
207          and the known_tasks_addr is irrelevant;
208        - ADA_TASKS_ARRAY: The known_tasks is an array;
209        - ADA_TASKS_LIST: The known_tasks is a list.  */
210   enum ada_known_tasks_kind known_tasks_kind;
211
212   /* The address of the known_tasks structure.  This is where
213      the runtime stores the information for all Ada tasks.
214      The interpretation of this field depends on KNOWN_TASKS_KIND
215      above.  */
216   CORE_ADDR known_tasks_addr;
217
218   /* When nonzero, this flag indicates that the task_list field
219      below is up to date.  When set to zero, the list has either
220      not been initialized, or has potentially become stale.  */
221   int task_list_valid_p;
222
223   /* The list of Ada tasks.
224
225      Note: To each task we associate a number that the user can use to
226      reference it - this number is printed beside each task in the tasks
227      info listing displayed by "info tasks".  This number is equal to
228      its index in the vector + 1.  Reciprocally, to compute the index
229      of a task in the vector, we need to substract 1 from its number.  */
230   VEC(ada_task_info_s) *task_list;
231 };
232
233 /* Key to our per-inferior data.  */
234 static const struct inferior_data *ada_tasks_inferior_data_handle;
235
236 /* Return the ada-tasks module's data for the given program space (PSPACE).
237    If none is found, add a zero'ed one now.
238
239    This function always returns a valid object.  */
240
241 static struct ada_tasks_pspace_data *
242 get_ada_tasks_pspace_data (struct program_space *pspace)
243 {
244   struct ada_tasks_pspace_data *data;
245
246   data = program_space_data (pspace, ada_tasks_pspace_data_handle);
247   if (data == NULL)
248     {
249       data = XZALLOC (struct ada_tasks_pspace_data);
250       set_program_space_data (pspace, ada_tasks_pspace_data_handle, data);
251     }
252
253   return data;
254 }
255
256 /* Return the ada-tasks module's data for the given inferior (INF).
257    If none is found, add a zero'ed one now.
258
259    This function always returns a valid object.
260
261    Note that we could use an observer of the inferior-created event
262    to make sure that the ada-tasks per-inferior data always exists.
263    But we prefered this approach, as it avoids this entirely as long
264    as the user does not use any of the tasking features.  This is
265    quite possible, particularly in the case where the inferior does
266    not use tasking.  */
267
268 static struct ada_tasks_inferior_data *
269 get_ada_tasks_inferior_data (struct inferior *inf)
270 {
271   struct ada_tasks_inferior_data *data;
272
273   data = inferior_data (inf, ada_tasks_inferior_data_handle);
274   if (data == NULL)
275     {
276       data = XZALLOC (struct ada_tasks_inferior_data);
277       set_inferior_data (inf, ada_tasks_inferior_data_handle, data);
278     }
279
280   return data;
281 }
282
283 /* Return the task number of the task whose ptid is PTID, or zero
284    if the task could not be found.  */
285
286 int
287 ada_get_task_number (ptid_t ptid)
288 {
289   int i;
290   struct inferior *inf = find_inferior_pid (ptid_get_pid (ptid));
291   struct ada_tasks_inferior_data *data;
292
293   gdb_assert (inf != NULL);
294   data = get_ada_tasks_inferior_data (inf);
295
296   for (i = 0; i < VEC_length (ada_task_info_s, data->task_list); i++)
297     if (ptid_equal (VEC_index (ada_task_info_s, data->task_list, i)->ptid,
298                     ptid))
299       return i + 1;
300
301   return 0;  /* No matching task found.  */
302 }
303
304 /* Return the task number of the task running in inferior INF which
305    matches TASK_ID , or zero if the task could not be found.  */
306  
307 static int
308 get_task_number_from_id (CORE_ADDR task_id, struct inferior *inf)
309 {
310   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
311   int i;
312
313   for (i = 0; i < VEC_length (ada_task_info_s, data->task_list); i++)
314     {
315       struct ada_task_info *task_info =
316         VEC_index (ada_task_info_s, data->task_list, i);
317
318       if (task_info->task_id == task_id)
319         return i + 1;
320     }
321
322   /* Task not found.  Return 0.  */
323   return 0;
324 }
325
326 /* Return non-zero if TASK_NUM is a valid task number.  */
327
328 int
329 valid_task_id (int task_num)
330 {
331   struct ada_tasks_inferior_data *data;
332
333   ada_build_task_list ();
334   data = get_ada_tasks_inferior_data (current_inferior ());
335   return (task_num > 0
336           && task_num <= VEC_length (ada_task_info_s, data->task_list));
337 }
338
339 /* Return non-zero iff the task STATE corresponds to a non-terminated
340    task state.  */
341
342 static int
343 ada_task_is_alive (struct ada_task_info *task_info)
344 {
345   return (task_info->state != Terminated);
346 }
347
348 /* Call the ITERATOR function once for each Ada task that hasn't been
349    terminated yet.  */
350
351 void
352 iterate_over_live_ada_tasks (ada_task_list_iterator_ftype *iterator)
353 {
354   int i, nb_tasks;
355   struct ada_task_info *task;
356   struct ada_tasks_inferior_data *data;
357
358   ada_build_task_list ();
359   data = get_ada_tasks_inferior_data (current_inferior ());
360   nb_tasks = VEC_length (ada_task_info_s, data->task_list);
361
362   for (i = 0; i < nb_tasks; i++)
363     {
364       task = VEC_index (ada_task_info_s, data->task_list, i);
365       if (!ada_task_is_alive (task))
366         continue;
367       iterator (task);
368     }
369 }
370
371 /* Extract the contents of the value as a string whose length is LENGTH,
372    and store the result in DEST.  */
373
374 static void
375 value_as_string (char *dest, struct value *val, int length)
376 {
377   memcpy (dest, value_contents (val), length);
378   dest[length] = '\0';
379 }
380
381 /* Extract the string image from the fat string corresponding to VAL,
382    and store it in DEST.  If the string length is greater than MAX_LEN,
383    then truncate the result to the first MAX_LEN characters of the fat
384    string.  */
385
386 static void
387 read_fat_string_value (char *dest, struct value *val, int max_len)
388 {
389   struct value *array_val;
390   struct value *bounds_val;
391   int len;
392
393   /* The following variables are made static to avoid recomputing them
394      each time this function is called.  */
395   static int initialize_fieldnos = 1;
396   static int array_fieldno;
397   static int bounds_fieldno;
398   static int upper_bound_fieldno;
399
400   /* Get the index of the fields that we will need to read in order
401      to extract the string from the fat string.  */
402   if (initialize_fieldnos)
403     {
404       struct type *type = value_type (val);
405       struct type *bounds_type;
406
407       array_fieldno = ada_get_field_index (type, "P_ARRAY", 0);
408       bounds_fieldno = ada_get_field_index (type, "P_BOUNDS", 0);
409
410       bounds_type = TYPE_FIELD_TYPE (type, bounds_fieldno);
411       if (TYPE_CODE (bounds_type) == TYPE_CODE_PTR)
412         bounds_type = TYPE_TARGET_TYPE (bounds_type);
413       if (TYPE_CODE (bounds_type) != TYPE_CODE_STRUCT)
414         error (_("Unknown task name format. Aborting"));
415       upper_bound_fieldno = ada_get_field_index (bounds_type, "UB0", 0);
416
417       initialize_fieldnos = 0;
418     }
419
420   /* Get the size of the task image by checking the value of the bounds.
421      The lower bound is always 1, so we only need to read the upper bound.  */
422   bounds_val = value_ind (value_field (val, bounds_fieldno));
423   len = value_as_long (value_field (bounds_val, upper_bound_fieldno));
424
425   /* Make sure that we do not read more than max_len characters...  */
426   if (len > max_len)
427     len = max_len;
428
429   /* Extract LEN characters from the fat string.  */
430   array_val = value_ind (value_field (val, array_fieldno));
431   read_memory (value_address (array_val), dest, len);
432
433   /* Add the NUL character to close the string.  */
434   dest[len] = '\0';
435 }
436
437 /* Get from the debugging information the type description of all types
438    related to the Ada Task Control Block that will be needed in order to
439    read the list of known tasks in the Ada runtime.  Also return the
440    associated ATCB_FIELDNOS.
441
442    Error handling:  Any data missing from the debugging info will cause
443    an error to be raised, and none of the return values to be set.
444    Users of this function can depend on the fact that all or none of the
445    return values will be set.  */
446
447 static void
448 get_tcb_types_info (void)
449 {
450   struct type *type;
451   struct type *common_type;
452   struct type *ll_type;
453   struct type *call_type;
454   struct atcb_fieldnos fieldnos;
455   struct ada_tasks_pspace_data *pspace_data;
456
457   const char *atcb_name = "system__tasking__ada_task_control_block___XVE";
458   const char *atcb_name_fixed = "system__tasking__ada_task_control_block";
459   const char *common_atcb_name = "system__tasking__common_atcb";
460   const char *private_data_name = "system__task_primitives__private_data";
461   const char *entry_call_record_name = "system__tasking__entry_call_record";
462
463   /* ATCB symbols may be found in several compilation units.  As we
464      are only interested in one instance, use standard (literal,
465      C-like) lookups to get the first match.  */
466
467   struct symbol *atcb_sym =
468     lookup_symbol_in_language (atcb_name, NULL, VAR_DOMAIN,
469                                language_c, NULL);
470   const struct symbol *common_atcb_sym =
471     lookup_symbol_in_language (common_atcb_name, NULL, VAR_DOMAIN,
472                                language_c, NULL);
473   const struct symbol *private_data_sym =
474     lookup_symbol_in_language (private_data_name, NULL, VAR_DOMAIN,
475                                language_c, NULL);
476   const struct symbol *entry_call_record_sym =
477     lookup_symbol_in_language (entry_call_record_name, NULL, VAR_DOMAIN,
478                                language_c, NULL);
479
480   if (atcb_sym == NULL || atcb_sym->type == NULL)
481     {
482       /* In Ravenscar run-time libs, the  ATCB does not have a dynamic
483          size, so the symbol name differs.  */
484       atcb_sym = lookup_symbol_in_language (atcb_name_fixed, NULL, VAR_DOMAIN,
485                                             language_c, NULL);
486
487       if (atcb_sym == NULL || atcb_sym->type == NULL)
488         error (_("Cannot find Ada_Task_Control_Block type. Aborting"));
489
490       type = atcb_sym->type;
491     }
492   else
493     {
494       /* Get a static representation of the type record
495          Ada_Task_Control_Block.  */
496       type = atcb_sym->type;
497       type = ada_template_to_fixed_record_type_1 (type, NULL, 0, NULL, 0);
498     }
499
500   if (common_atcb_sym == NULL || common_atcb_sym->type == NULL)
501     error (_("Cannot find Common_ATCB type. Aborting"));
502   if (private_data_sym == NULL || private_data_sym->type == NULL)
503     error (_("Cannot find Private_Data type. Aborting"));
504   if (entry_call_record_sym == NULL || entry_call_record_sym->type == NULL)
505     error (_("Cannot find Entry_Call_Record type. Aborting"));
506
507   /* Get the type for Ada_Task_Control_Block.Common.  */
508   common_type = common_atcb_sym->type;
509
510   /* Get the type for Ada_Task_Control_Bloc.Common.Call.LL.  */
511   ll_type = private_data_sym->type;
512
513   /* Get the type for Common_ATCB.Call.all.  */
514   call_type = entry_call_record_sym->type;
515
516   /* Get the field indices.  */
517   fieldnos.common = ada_get_field_index (type, "common", 0);
518   fieldnos.entry_calls = ada_get_field_index (type, "entry_calls", 1);
519   fieldnos.atc_nesting_level =
520     ada_get_field_index (type, "atc_nesting_level", 1);
521   fieldnos.state = ada_get_field_index (common_type, "state", 0);
522   fieldnos.parent = ada_get_field_index (common_type, "parent", 1);
523   fieldnos.priority = ada_get_field_index (common_type, "base_priority", 0);
524   fieldnos.image = ada_get_field_index (common_type, "task_image", 1);
525   fieldnos.image_len = ada_get_field_index (common_type, "task_image_len", 1);
526   fieldnos.activation_link = ada_get_field_index (common_type,
527                                                   "activation_link", 1);
528   fieldnos.call = ada_get_field_index (common_type, "call", 1);
529   fieldnos.ll = ada_get_field_index (common_type, "ll", 0);
530   fieldnos.ll_thread = ada_get_field_index (ll_type, "thread", 0);
531   fieldnos.ll_lwp = ada_get_field_index (ll_type, "lwp", 1);
532   fieldnos.call_self = ada_get_field_index (call_type, "self", 0);
533
534   /* On certain platforms such as x86-windows, the "lwp" field has been
535      named "thread_id".  This field will likely be renamed in the future,
536      but we need to support both possibilities to avoid an unnecessary
537      dependency on a recent compiler.  We therefore try locating the
538      "thread_id" field in place of the "lwp" field if we did not find
539      the latter.  */
540   if (fieldnos.ll_lwp < 0)
541     fieldnos.ll_lwp = ada_get_field_index (ll_type, "thread_id", 1);
542
543   /* Set all the out parameters all at once, now that we are certain
544      that there are no potential error() anymore.  */
545   pspace_data = get_ada_tasks_pspace_data (current_program_space);
546   pspace_data->initialized_p = 1;
547   pspace_data->atcb_type = type;
548   pspace_data->atcb_common_type = common_type;
549   pspace_data->atcb_ll_type = ll_type;
550   pspace_data->atcb_call_type = call_type;
551   pspace_data->atcb_fieldno = fieldnos;
552 }
553
554 /* Build the PTID of the task from its COMMON_VALUE, which is the "Common"
555    component of its ATCB record.  This PTID needs to match the PTID used
556    by the thread layer.  */
557
558 static ptid_t
559 ptid_from_atcb_common (struct value *common_value)
560 {
561   long thread = 0;
562   CORE_ADDR lwp = 0;
563   struct value *ll_value;
564   ptid_t ptid;
565   const struct ada_tasks_pspace_data *pspace_data
566     = get_ada_tasks_pspace_data (current_program_space);
567
568   ll_value = value_field (common_value, pspace_data->atcb_fieldno.ll);
569
570   if (pspace_data->atcb_fieldno.ll_lwp >= 0)
571     lwp = value_as_address (value_field (ll_value,
572                                          pspace_data->atcb_fieldno.ll_lwp));
573   thread = value_as_long (value_field (ll_value,
574                                        pspace_data->atcb_fieldno.ll_thread));
575
576   ptid = target_get_ada_task_ptid (lwp, thread);
577
578   return ptid;
579 }
580
581 /* Read the ATCB data of a given task given its TASK_ID (which is in practice
582    the address of its assocated ATCB record), and store the result inside
583    TASK_INFO.  */
584
585 static void
586 read_atcb (CORE_ADDR task_id, struct ada_task_info *task_info)
587 {
588   struct value *tcb_value;
589   struct value *common_value;
590   struct value *atc_nesting_level_value;
591   struct value *entry_calls_value;
592   struct value *entry_calls_value_element;
593   int called_task_fieldno = -1;
594   const char ravenscar_task_name[] = "Ravenscar task";
595   const struct ada_tasks_pspace_data *pspace_data
596     = get_ada_tasks_pspace_data (current_program_space);
597
598   if (!pspace_data->initialized_p)
599     get_tcb_types_info ();
600
601   tcb_value = value_from_contents_and_address (pspace_data->atcb_type,
602                                                NULL, task_id);
603   common_value = value_field (tcb_value, pspace_data->atcb_fieldno.common);
604
605   /* Fill in the task_id.  */
606
607   task_info->task_id = task_id;
608
609   /* Compute the name of the task.
610
611      Depending on the GNAT version used, the task image is either a fat
612      string, or a thin array of characters.  Older versions of GNAT used
613      to use fat strings, and therefore did not need an extra field in
614      the ATCB to store the string length.  For efficiency reasons, newer
615      versions of GNAT replaced the fat string by a static buffer, but this
616      also required the addition of a new field named "Image_Len" containing
617      the length of the task name.  The method used to extract the task name
618      is selected depending on the existence of this field.
619
620      In some run-time libs (e.g. Ravenscar), the name is not in the ATCB;
621      we may want to get it from the first user frame of the stack.  For now,
622      we just give a dummy name.  */
623
624   if (pspace_data->atcb_fieldno.image_len == -1)
625     {
626       if (pspace_data->atcb_fieldno.image >= 0)
627         read_fat_string_value (task_info->name,
628                                value_field (common_value,
629                                             pspace_data->atcb_fieldno.image),
630                                sizeof (task_info->name) - 1);
631       else
632         strcpy (task_info->name, ravenscar_task_name);
633     }
634   else
635     {
636       int len = value_as_long
637                   (value_field (common_value,
638                                 pspace_data->atcb_fieldno.image_len));
639
640       value_as_string (task_info->name,
641                        value_field (common_value,
642                                     pspace_data->atcb_fieldno.image),
643                        len);
644     }
645
646   /* Compute the task state and priority.  */
647
648   task_info->state =
649     value_as_long (value_field (common_value,
650                                 pspace_data->atcb_fieldno.state));
651   task_info->priority =
652     value_as_long (value_field (common_value,
653                                 pspace_data->atcb_fieldno.priority));
654
655   /* If the ATCB contains some information about the parent task,
656      then compute it as well.  Otherwise, zero.  */
657
658   if (pspace_data->atcb_fieldno.parent >= 0)
659     task_info->parent =
660       value_as_address (value_field (common_value,
661                                      pspace_data->atcb_fieldno.parent));
662   else
663     task_info->parent = 0;
664   
665
666   /* If the ATCB contains some information about entry calls, then
667      compute the "called_task" as well.  Otherwise, zero.  */
668
669   if (pspace_data->atcb_fieldno.atc_nesting_level > 0
670       && pspace_data->atcb_fieldno.entry_calls > 0)
671     {
672       /* Let My_ATCB be the Ada task control block of a task calling the
673          entry of another task; then the Task_Id of the called task is
674          in My_ATCB.Entry_Calls (My_ATCB.ATC_Nesting_Level).Called_Task.  */
675       atc_nesting_level_value =
676         value_field (tcb_value, pspace_data->atcb_fieldno.atc_nesting_level);
677       entry_calls_value =
678         ada_coerce_to_simple_array_ptr
679           (value_field (tcb_value, pspace_data->atcb_fieldno.entry_calls));
680       entry_calls_value_element =
681         value_subscript (entry_calls_value,
682                          value_as_long (atc_nesting_level_value));
683       called_task_fieldno =
684         ada_get_field_index (value_type (entry_calls_value_element),
685                              "called_task", 0);
686       task_info->called_task =
687         value_as_address (value_field (entry_calls_value_element,
688                                        called_task_fieldno));
689     }
690   else
691     {
692       task_info->called_task = 0;
693     }
694
695   /* If the ATCB cotnains some information about RV callers,
696      then compute the "caller_task".  Otherwise, zero.  */
697
698   task_info->caller_task = 0;
699   if (pspace_data->atcb_fieldno.call >= 0)
700     {
701       /* Get the ID of the caller task from Common_ATCB.Call.all.Self.
702          If Common_ATCB.Call is null, then there is no caller.  */
703       const CORE_ADDR call =
704         value_as_address (value_field (common_value,
705                                        pspace_data->atcb_fieldno.call));
706       struct value *call_val;
707
708       if (call != 0)
709         {
710           call_val =
711             value_from_contents_and_address (pspace_data->atcb_call_type,
712                                              NULL, call);
713           task_info->caller_task =
714             value_as_address
715               (value_field (call_val, pspace_data->atcb_fieldno.call_self));
716         }
717     }
718
719   /* And finally, compute the task ptid.  Note that there are situations
720      where this cannot be determined:
721        - The task is no longer alive - the ptid is irrelevant;
722        - We are debugging a core file - the thread is not always
723          completely preserved for us to link back a task to its
724          underlying thread.  Since we do not support task switching
725          when debugging core files anyway, we don't need to compute
726          that task ptid.
727      In either case, we don't need that ptid, and it is just good enough
728      to set it to null_ptid.  */
729
730   if (target_has_execution && ada_task_is_alive (task_info))
731     task_info->ptid = ptid_from_atcb_common (common_value);
732   else
733     task_info->ptid = null_ptid;
734 }
735
736 /* Read the ATCB info of the given task (identified by TASK_ID), and
737    add the result to the given inferior's TASK_LIST.  */
738
739 static void
740 add_ada_task (CORE_ADDR task_id, struct inferior *inf)
741 {
742   struct ada_task_info task_info;
743   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
744
745   read_atcb (task_id, &task_info);
746   VEC_safe_push (ada_task_info_s, data->task_list, &task_info);
747 }
748
749 /* Read the Known_Tasks array from the inferior memory, and store
750    it in the current inferior's TASK_LIST.  Return non-zero upon success.  */
751
752 static int
753 read_known_tasks_array (CORE_ADDR known_tasks_addr)
754 {
755   const int target_ptr_byte =
756     gdbarch_ptr_bit (target_gdbarch) / TARGET_CHAR_BIT;
757   const int known_tasks_size = target_ptr_byte * MAX_NUMBER_OF_KNOWN_TASKS;
758   gdb_byte *known_tasks = alloca (known_tasks_size);
759   int i;
760
761   /* Build a new list by reading the ATCBs from the Known_Tasks array
762      in the Ada runtime.  */
763   read_memory (known_tasks_addr, known_tasks, known_tasks_size);
764   for (i = 0; i < MAX_NUMBER_OF_KNOWN_TASKS; i++)
765     {
766       struct type *data_ptr_type =
767         builtin_type (target_gdbarch)->builtin_data_ptr;
768       CORE_ADDR task_id =
769         extract_typed_address (known_tasks + i * target_ptr_byte,
770                                data_ptr_type);
771
772       if (task_id != 0)
773         add_ada_task (task_id, current_inferior ());
774     }
775
776   return 1;
777 }
778
779 /* Read the known tasks from the inferior memory, and store it in
780    the current inferior's TASK_LIST.  Return non-zero upon success.  */
781
782 static int
783 read_known_tasks_list (CORE_ADDR known_tasks_addr)
784 {
785   const int target_ptr_byte =
786     gdbarch_ptr_bit (target_gdbarch) / TARGET_CHAR_BIT;
787   gdb_byte *known_tasks = alloca (target_ptr_byte);
788   struct type *data_ptr_type =
789     builtin_type (target_gdbarch)->builtin_data_ptr;
790   CORE_ADDR task_id;
791   const struct ada_tasks_pspace_data *pspace_data
792     = get_ada_tasks_pspace_data (current_program_space);
793
794   /* Sanity check.  */
795   if (pspace_data->atcb_fieldno.activation_link < 0)
796     return 0;
797
798   /* Build a new list by reading the ATCBs.  Read head of the list.  */
799   read_memory (known_tasks_addr, known_tasks, target_ptr_byte);
800   task_id = extract_typed_address (known_tasks, data_ptr_type);
801   while (task_id != 0)
802     {
803       struct value *tcb_value;
804       struct value *common_value;
805
806       add_ada_task (task_id, current_inferior ());
807
808       /* Read the chain.  */
809       tcb_value = value_from_contents_and_address (pspace_data->atcb_type,
810                                                    NULL, task_id);
811       common_value = value_field (tcb_value, pspace_data->atcb_fieldno.common);
812       task_id = value_as_address
813                   (value_field (common_value,
814                                 pspace_data->atcb_fieldno.activation_link));
815     }
816
817   return 1;
818 }
819
820 /* Return the address of the variable NAME that contains all the known
821    tasks maintained in the Ada Runtime.  Return NULL if the variable
822    could not be found, meaning that the inferior program probably does
823    not use tasking.  */
824
825 static CORE_ADDR
826 get_known_tasks_addr (const char *name)
827 {
828   struct minimal_symbol *msym;
829
830   msym = lookup_minimal_symbol (name, NULL, NULL);
831   if (msym == NULL)
832     return 0;
833
834   return SYMBOL_VALUE_ADDRESS (msym);
835 }
836
837 /* Assuming DATA is the ada-tasks' data for the current inferior,
838    set the known_tasks_kind and known_tasks_addr fields.  Do nothing
839    if those fields are already set and still up to date.  */
840
841 static void
842 ada_set_current_inferior_known_tasks_addr (struct ada_tasks_inferior_data *data)
843 {
844   CORE_ADDR known_tasks_addr;
845
846   if (data->known_tasks_kind != ADA_TASKS_UNKNOWN)
847     return;
848
849   known_tasks_addr = get_known_tasks_addr (KNOWN_TASKS_NAME);
850   if (known_tasks_addr != 0)
851     {
852       data->known_tasks_kind = ADA_TASKS_ARRAY;
853       data->known_tasks_addr = known_tasks_addr;
854       return;
855     }
856
857   known_tasks_addr = get_known_tasks_addr (KNOWN_TASKS_LIST);
858   if (known_tasks_addr != 0)
859     {
860       data->known_tasks_kind = ADA_TASKS_LIST;
861       data->known_tasks_addr = known_tasks_addr;
862       return;
863     }
864
865   data->known_tasks_kind = ADA_TASKS_NOT_FOUND;
866   data->known_tasks_addr = 0;
867 }
868
869 /* Read the known tasks from the current inferior's memory, and store it
870    in the current inferior's data TASK_LIST.
871    Return non-zero upon success.  */
872
873 static int
874 read_known_tasks (void)
875 {
876   struct ada_tasks_inferior_data *data =
877     get_ada_tasks_inferior_data (current_inferior ());
878
879   /* Step 1: Clear the current list, if necessary.  */
880   VEC_truncate (ada_task_info_s, data->task_list, 0);
881
882   /* Step 2: do the real work.
883      If the application does not use task, then no more needs to be done.
884      It is important to have the task list cleared (see above) before we
885      return, as we don't want a stale task list to be used...  This can
886      happen for instance when debugging a non-multitasking program after
887      having debugged a multitasking one.  */
888   ada_set_current_inferior_known_tasks_addr (data);
889   gdb_assert (data->known_tasks_kind != ADA_TASKS_UNKNOWN);
890
891   switch (data->known_tasks_kind)
892     {
893       case ADA_TASKS_NOT_FOUND: /* Tasking not in use in inferior.  */
894         return 0;
895       case ADA_TASKS_ARRAY:
896         return read_known_tasks_array (data->known_tasks_addr);
897       case ADA_TASKS_LIST:
898         return read_known_tasks_list (data->known_tasks_addr);
899     }
900
901   /* Step 3: Set task_list_valid_p, to avoid re-reading the Known_Tasks
902      array unless needed.  Then report a success.  */
903   data->task_list_valid_p = 1;
904
905   return 1;
906 }
907
908 /* Build the task_list by reading the Known_Tasks array from
909    the inferior, and return the number of tasks in that list
910    (zero means that the program is not using tasking at all).  */
911
912 int
913 ada_build_task_list (void)
914 {
915   struct ada_tasks_inferior_data *data;
916
917   if (!target_has_stack)
918     error (_("Cannot inspect Ada tasks when program is not running"));
919
920   data = get_ada_tasks_inferior_data (current_inferior ());
921   if (!data->task_list_valid_p)
922     read_known_tasks ();
923
924   return VEC_length (ada_task_info_s, data->task_list);
925 }
926
927 /* Print a one-line description of the task running in inferior INF
928    whose number is TASKNO.
929
930    The formatting should fit the "info tasks" array.  */
931
932 static void
933 short_task_info (int taskno, struct inferior *inf)
934 {
935   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
936   const struct ada_task_info *const task_info =
937     VEC_index (ada_task_info_s, data->task_list, taskno - 1);
938   int active_task_p;
939
940   gdb_assert (task_info != NULL);
941
942   /* Print a star if this task is the current task (or the task currently
943      selected).  */
944
945   active_task_p = ptid_equal (task_info->ptid, inferior_ptid);
946   if (active_task_p)
947     printf_filtered ("*");
948   else
949     printf_filtered (" ");
950
951   /* Print the task number.  */
952   printf_filtered ("%3d", taskno);
953
954   /* Print the Task ID.  */
955   printf_filtered (" %9lx", (long) task_info->task_id);
956
957   /* Print the Task ID of the task parent.  */
958   printf_filtered (" %4d", get_task_number_from_id (task_info->parent, inf));
959
960   /* Print the base priority of the task.  */
961   printf_filtered (" %3d", task_info->priority);
962
963   /* Print the task current state.  */
964   if (task_info->caller_task)
965     printf_filtered (_(" Accepting RV with %-4d"),
966                      get_task_number_from_id (task_info->caller_task, inf));
967   else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
968     printf_filtered (_(" Waiting on RV with %-3d"),
969                      get_task_number_from_id (task_info->called_task, inf));
970   else
971     printf_filtered (" %-22s", _(task_states[task_info->state]));
972
973   /* Finally, print the task name.  */
974   if (task_info->name[0] != '\0')
975     printf_filtered (" %s\n", task_info->name);
976   else
977     printf_filtered (_(" <no name>\n"));
978 }
979
980 /* Print a list containing a short description of all Ada tasks
981    running inside inferior INF.  */
982 /* FIXME: Shouldn't we be using ui_out???  */
983
984 static void
985 info_tasks (struct inferior *inf)
986 {
987   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
988   int taskno;
989   const int nb_tasks = VEC_length (ada_task_info_s, data->task_list);
990
991   printf_filtered (_("  ID       TID P-ID Pri State                  Name\n"));
992   
993   for (taskno = 1; taskno <= nb_tasks; taskno++)
994     short_task_info (taskno, inf);
995 }
996
997 /* Print a detailed description of the Ada task whose ID is TASKNO_STR
998    for the given inferior (INF).  */
999
1000 static void
1001 info_task (char *taskno_str, int from_tty, struct inferior *inf)
1002 {
1003   const int taskno = value_as_long (parse_and_eval (taskno_str));
1004   struct ada_task_info *task_info;
1005   int parent_taskno = 0;
1006   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
1007
1008   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, data->task_list))
1009     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
1010              "see the IDs of currently known tasks"), taskno);
1011   task_info = VEC_index (ada_task_info_s, data->task_list, taskno - 1);
1012
1013   /* Print the Ada task ID.  */
1014   printf_filtered (_("Ada Task: %s\n"),
1015                    paddress (target_gdbarch, task_info->task_id));
1016
1017   /* Print the name of the task.  */
1018   if (task_info->name[0] != '\0')
1019     printf_filtered (_("Name: %s\n"), task_info->name);
1020   else
1021     printf_filtered (_("<no name>\n"));
1022
1023   /* Print the TID and LWP.  */
1024   printf_filtered (_("Thread: %#lx\n"), ptid_get_tid (task_info->ptid));
1025   printf_filtered (_("LWP: %#lx\n"), ptid_get_lwp (task_info->ptid));
1026
1027   /* Print who is the parent (if any).  */
1028   if (task_info->parent != 0)
1029     parent_taskno = get_task_number_from_id (task_info->parent, inf);
1030   if (parent_taskno)
1031     {
1032       struct ada_task_info *parent =
1033         VEC_index (ada_task_info_s, data->task_list, parent_taskno - 1);
1034
1035       printf_filtered (_("Parent: %d"), parent_taskno);
1036       if (parent->name[0] != '\0')
1037         printf_filtered (" (%s)", parent->name);
1038       printf_filtered ("\n");
1039     }
1040   else
1041     printf_filtered (_("No parent\n"));
1042
1043   /* Print the base priority.  */
1044   printf_filtered (_("Base Priority: %d\n"), task_info->priority);
1045
1046   /* print the task current state.  */
1047   {
1048     int target_taskno = 0;
1049
1050     if (task_info->caller_task)
1051       {
1052         target_taskno = get_task_number_from_id (task_info->caller_task, inf);
1053         printf_filtered (_("State: Accepting rendezvous with %d"),
1054                          target_taskno);
1055       }
1056     else if (task_info->state == Entry_Caller_Sleep && task_info->called_task)
1057       {
1058         target_taskno = get_task_number_from_id (task_info->called_task, inf);
1059         printf_filtered (_("State: Waiting on task %d's entry"),
1060                          target_taskno);
1061       }
1062     else
1063       printf_filtered (_("State: %s"), _(long_task_states[task_info->state]));
1064
1065     if (target_taskno)
1066       {
1067         struct ada_task_info *target_task_info =
1068           VEC_index (ada_task_info_s, data->task_list, target_taskno - 1);
1069
1070         if (target_task_info->name[0] != '\0')
1071           printf_filtered (" (%s)", target_task_info->name);
1072       }
1073
1074     printf_filtered ("\n");
1075   }
1076 }
1077
1078 /* If ARG is empty or null, then print a list of all Ada tasks.
1079    Otherwise, print detailed information about the task whose ID
1080    is ARG.
1081    
1082    Does nothing if the program doesn't use Ada tasking.  */
1083
1084 static void
1085 info_tasks_command (char *arg, int from_tty)
1086 {
1087   struct ui_out *uiout = current_uiout;
1088
1089   if (ada_build_task_list () == 0)
1090     {
1091       ui_out_message (uiout, 0,
1092                       _("Your application does not use any Ada tasks.\n"));
1093       return;
1094     }
1095
1096   if (arg == NULL || *arg == '\0')
1097     info_tasks (current_inferior ());
1098   else
1099     info_task (arg, from_tty, current_inferior ());
1100 }
1101
1102 /* Print a message telling the user id of the current task.
1103    This function assumes that tasking is in use in the inferior.  */
1104
1105 static void
1106 display_current_task_id (void)
1107 {
1108   const int current_task = ada_get_task_number (inferior_ptid);
1109
1110   if (current_task == 0)
1111     printf_filtered (_("[Current task is unknown]\n"));
1112   else
1113     printf_filtered (_("[Current task is %d]\n"), current_task);
1114 }
1115
1116 /* Parse and evaluate TIDSTR into a task id, and try to switch to
1117    that task.  Print an error message if the task switch failed.  */
1118
1119 static void
1120 task_command_1 (char *taskno_str, int from_tty, struct inferior *inf)
1121 {
1122   const int taskno = value_as_long (parse_and_eval (taskno_str));
1123   struct ada_task_info *task_info;
1124   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
1125
1126   if (taskno <= 0 || taskno > VEC_length (ada_task_info_s, data->task_list))
1127     error (_("Task ID %d not known.  Use the \"info tasks\" command to\n"
1128              "see the IDs of currently known tasks"), taskno);
1129   task_info = VEC_index (ada_task_info_s, data->task_list, taskno - 1);
1130
1131   if (!ada_task_is_alive (task_info))
1132     error (_("Cannot switch to task %d: Task is no longer running"), taskno);
1133    
1134   /* On some platforms, the thread list is not updated until the user
1135      performs a thread-related operation (by using the "info threads"
1136      command, for instance).  So this thread list may not be up to date
1137      when the user attempts this task switch.  Since we cannot switch
1138      to the thread associated to our task if GDB does not know about
1139      that thread, we need to make sure that any new threads gets added
1140      to the thread list.  */
1141   target_find_new_threads ();
1142
1143   /* Verify that the ptid of the task we want to switch to is valid
1144      (in other words, a ptid that GDB knows about).  Otherwise, we will
1145      cause an assertion failure later on, when we try to determine
1146      the ptid associated thread_info data.  We should normally never
1147      encounter such an error, but the wrong ptid can actually easily be
1148      computed if target_get_ada_task_ptid has not been implemented for
1149      our target (yet).  Rather than cause an assertion error in that case,
1150      it's nicer for the user to just refuse to perform the task switch.  */
1151   if (!find_thread_ptid (task_info->ptid))
1152     error (_("Unable to compute thread ID for task %d.\n"
1153              "Cannot switch to this task."),
1154            taskno);
1155
1156   switch_to_thread (task_info->ptid);
1157   ada_find_printable_frame (get_selected_frame (NULL));
1158   printf_filtered (_("[Switching to task %d]\n"), taskno);
1159   print_stack_frame (get_selected_frame (NULL),
1160                      frame_relative_level (get_selected_frame (NULL)), 1);
1161 }
1162
1163
1164 /* Print the ID of the current task if TASKNO_STR is empty or NULL.
1165    Otherwise, switch to the task indicated by TASKNO_STR.  */
1166
1167 static void
1168 task_command (char *taskno_str, int from_tty)
1169 {
1170   struct ui_out *uiout = current_uiout;
1171
1172   if (ada_build_task_list () == 0)
1173     {
1174       ui_out_message (uiout, 0,
1175                       _("Your application does not use any Ada tasks.\n"));
1176       return;
1177     }
1178
1179   if (taskno_str == NULL || taskno_str[0] == '\0')
1180     display_current_task_id ();
1181   else
1182     {
1183       /* Task switching in core files doesn't work, either because:
1184            1. Thread support is not implemented with core files
1185            2. Thread support is implemented, but the thread IDs created
1186               after having read the core file are not the same as the ones
1187               that were used during the program life, before the crash.
1188               As a consequence, there is no longer a way for the debugger
1189               to find the associated thead ID of any given Ada task.
1190          So, instead of attempting a task switch without giving the user
1191          any clue as to what might have happened, just error-out with
1192          a message explaining that this feature is not supported.  */
1193       if (!target_has_execution)
1194         error (_("\
1195 Task switching not supported when debugging from core files\n\
1196 (use thread support instead)"));
1197       task_command_1 (taskno_str, from_tty, current_inferior ());
1198     }
1199 }
1200
1201 /* Indicate that the given inferior's task list may have changed,
1202    so invalidate the cache.  */
1203
1204 static void
1205 ada_task_list_changed (struct inferior *inf)
1206 {
1207   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
1208
1209   data->task_list_valid_p = 0;
1210 }
1211
1212 /* Invalidate the per-program-space data.  */
1213
1214 static void
1215 ada_tasks_invalidate_pspace_data (struct program_space *pspace)
1216 {
1217   get_ada_tasks_pspace_data (pspace)->initialized_p = 0;
1218 }
1219
1220 /* Invalidate the per-inferior data.  */
1221
1222 static void
1223 ada_tasks_invalidate_inferior_data (struct inferior *inf)
1224 {
1225   struct ada_tasks_inferior_data *data = get_ada_tasks_inferior_data (inf);
1226
1227   data->known_tasks_kind = ADA_TASKS_UNKNOWN;
1228   data->task_list_valid_p = 0;
1229 }
1230
1231 /* The 'normal_stop' observer notification callback.  */
1232
1233 static void
1234 ada_normal_stop_observer (struct bpstats *unused_args, int unused_args2)
1235 {
1236   /* The inferior has been resumed, and just stopped. This means that
1237      our task_list needs to be recomputed before it can be used again.  */
1238   ada_task_list_changed (current_inferior ());
1239 }
1240
1241 /* A routine to be called when the objfiles have changed.  */
1242
1243 static void
1244 ada_new_objfile_observer (struct objfile *objfile)
1245 {
1246   struct inferior *inf;
1247
1248   /* Invalidate the relevant data in our program-space data.  */
1249
1250   if (objfile == NULL)
1251     {
1252       /* All objfiles are being cleared, so we should clear all
1253          our caches for all program spaces.  */
1254       struct program_space *pspace;
1255
1256       for (pspace = program_spaces; pspace != NULL; pspace = pspace->next)
1257         ada_tasks_invalidate_pspace_data (pspace);
1258     }
1259   else
1260     {
1261       /* The associated program-space data might have changed after
1262          this objfile was added.  Invalidate all cached data.  */
1263       ada_tasks_invalidate_pspace_data (objfile->pspace);
1264     }
1265
1266   /* Invalidate the per-inferior cache for all inferiors using
1267      this objfile (or, in other words, for all inferiors who have
1268      the same program-space as the objfile's program space).
1269      If all objfiles are being cleared (OBJFILE is NULL), then
1270      clear the caches for all inferiors.  */
1271
1272   for (inf = inferior_list; inf != NULL; inf = inf->next)
1273     if (objfile == NULL || inf->pspace == objfile->pspace)
1274       ada_tasks_invalidate_inferior_data (inf);
1275 }
1276
1277 /* Provide a prototype to silence -Wmissing-prototypes.  */
1278 extern initialize_file_ftype _initialize_tasks;
1279
1280 void
1281 _initialize_tasks (void)
1282 {
1283   ada_tasks_pspace_data_handle = register_program_space_data ();
1284   ada_tasks_inferior_data_handle = register_inferior_data ();
1285
1286   /* Attach various observers.  */
1287   observer_attach_normal_stop (ada_normal_stop_observer);
1288   observer_attach_new_objfile (ada_new_objfile_observer);
1289
1290   /* Some new commands provided by this module.  */
1291   add_info ("tasks", info_tasks_command,
1292             _("Provide information about all known Ada tasks"));
1293   add_cmd ("task", class_run, task_command,
1294            _("Use this command to switch between Ada tasks.\n\
1295 Without argument, this command simply prints the current task ID"),
1296            &cmdlist);
1297 }
1298